home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.004 / xemacs-1 / xemacs-19.13 / lisp / packages / mode-motion+.el < prev    next >
Encoding:
Text File  |  1995-08-22  |  78.2 KB  |  2,197 lines
  1. ;;   -*- Syntax: Emacs-Lisp; Mode: emacs-lisp -*-
  2. ;;
  3. ;; Per mode and per buffer mouse tracking with highlighting
  4. ;;
  5. ;; Copyright (C) 1992, 1993 by Guido Bosch <Guido.Bosch@loria.fr>
  6.  
  7. ;; This file is written in GNU Emacs Lisp, It is a part of XEmacs.
  8.  
  9. ;; The software contained in this file is free software; you can
  10. ;; redistribute it and/or modify it under the terms of the GNU General
  11. ;; Public License as published by the Free Software Foundation; either
  12. ;; version 2, or (at your option) any later version.
  13.  
  14. ;; GNU Emacs is distributed in the hope that it will be useful,
  15. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17. ;; GNU General Public License for more details.
  18.  
  19. ;; You should have received a copy of the GNU General Public License
  20. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  21. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  22. ;;
  23. ;; Please send bugs and comments to Russell.Ritchie@gssec.bt.co.uk or
  24. ;;                                  tlp00@spg.amdahl.com.
  25. ;;
  26. ;; <DISCLAIMER>
  27. ;; This program is still under development.  Neither the author nor any
  28. ;; of the maintainers accepts responsibility to anyone for the consequences of
  29. ;; using it or for whether it serves any particular purpose or works
  30. ;; at all.
  31.  
  32. ; Change History
  33. ; Revision 3.12 Wed Jul 12 11:30:43 1995 Russell.Ritchie@gssec.bt.co.uk
  34. ; Track `don't highlight non-file lines in dired buffers' functionality (in a
  35. ; pretty tasteless manner if I say so myself :-)).
  36.  
  37. ; Revision 3.11 Fri Jul  7 16:26:56 1995 Russell.Ritchie@gssec.bt.co.uk
  38. ; Minor extent detaching bug fix.
  39.  
  40. ; Revision 3.10 Thu Jun 15 11:36:56 1995 Russell.Ritchie@gssec.bt.co.uk
  41. ; Quiet, faster, non-interactive initialistion, mild list-motion-handlers
  42. ; chrome and minor formatting clean-ups.
  43.  
  44. ; Revision 3.9 Thu Jun 15 11:36:56 1995 Russell.Ritchie@gssec.bt.co.uk
  45. ; Fixed the `mouse-motion whilst reading filename in minibuffer auto-ftp' bug.
  46.  
  47. ; Revision 3.8 Thus Mar 23 1995 tlp00@spg.amdahl.com
  48. ; added in menu controls from paquette@atomas.crim.ca
  49. ; re-added minibuffer support (from 3.5)
  50. ;
  51. ; Revision 3.7 Tue Feb 21 11:06:38 1995 Russell.Ritchie@gssec.bt.co.uk
  52. ; Extended mode-motion+-religion and made the defaulting frame-buffer aware.
  53. ; Reworked and added new mode-motion-handlers.
  54. ; Doc string clean up.
  55. ; Fixed unintentional frame/screen reversion.
  56.  
  57. ; Revision 3.6 Mon Feb 20 11:46:32 1995 Russell.Ritchie@gssec.bt.co.uk
  58. ; Made mouse tracking use mode-motion-hook for better integration with
  59. ; the default mouse-motion system (help-echo and friends now work).
  60.  
  61. ; Revision 3.5 1995/02/16 13:40:00 tlp00@spg.amdahl.com
  62. ; fixed sporatic scroll bug
  63. ; added M-button2 binding for mode-motion-copy
  64. ;
  65. ; Revision 3.4 1995/02/14 14:30:15 Russell.Ritchie@gssec.bt.co.uk
  66. ; Small code cleanups: let* -> let, duplicate defvars.
  67. ; Chromed list-motion-handlers a little.
  68. ; Added variable mode-motion+-religion for easy choice twixt underline & bold.
  69.  
  70. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;tlp00 changes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  71.  
  72. ; tlp00@spg.amdahl.com 2/11/93
  73. ; modified mode-motion-track-pointer to move cursor cross windows
  74. ;          renamed mode-motion-delete to mode-motion-kill to follow kill
  75. ;            convention
  76. ;          mode-motion-highlight-with-handler to put cursor at beginning of line 
  77. ;            follow operations.
  78. ;          mode-motion-copy/delete and mode-motion-kill to position cursor at 
  79. ;            delete point start.  Also set this-command to avoid appends
  80. ; set mode-motion-extent priority to 1, so it will override font-lock
  81. ; changed default handlers for buffer-mode, c-mode, dired-mode, added occur 
  82. ;   and compilation mode.
  83. ; fixed bug in minibuffer-selection-boundaries where C-g was leaving the wrong
  84. ;   syntax table.
  85. ; added support for pending-delete.
  86. ; adds the copy/delete motion-extent to the clipboard even if kill-hooks is nil.
  87. ;
  88. ; Revision 3.3 1995/02/13 tlp00@spg.amdahl.com
  89. ; merged Russell.Ritchie@gssec.bt.co.uk versions with molli/bosch versions
  90. ; renamed versioning 3.0+ for molli/bosch versions.  
  91. ;
  92. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Russell Ritchie changes;;;;;;;;;;;;;;;;;;;;;;;;
  93. ; !Log: mode-motion+.el,v !
  94. ; Revision 2.14.R  1994/09/09  10:19:18  rieke@darmstadt.gmd.de
  95. ; Merged in my changes to support motion-gray. This needs a file
  96. ; named "gray1.xbm" in your data-directory (etc) like the following.
  97. ; -------------------------------snip--------------------------
  98. ; #define bg2_width 16
  99. ; #define bg2_height 16
  100. ; static char bg2_bits[] = {
  101. ;   0x55, 0x55, 0x00, 0x00, 0x55, 0x55, 0x00, 0x00, 0x55, 0x55, 0x00, 0x00,
  102. ;   0x55, 0x55, 0x00, 0x00, 0x55, 0x55, 0x00, 0x00, 0x55, 0x55, 0x00, 0x00,
  103. ;   0x55, 0x55, 0x00, 0x00, 0x55, 0x55, 0x00, 0x00};
  104. ; -------------------------------snip--------------------------
  105. ; This one looks good on SUN 19'' screens with 10x20 font, 
  106. ; black foreground and khaki background. 
  107. ; To use the gray-handlers instead of the underline-handlers
  108. ; include the following into your .emacs:
  109. ; (set-mode-motion-handler 'emacs-lisp-mode 'gray-thing)
  110. ; (set-mode-motion-handler 'lisp-interaction-mode 'gray-thing)
  111. ; (set-mode-motion-handler 'c++-mode 'gray-c)
  112. ; (set-mode-motion-handler 'c-mode 'gray-c)
  113. ; (set-mode-motion-handler 'tcl-mode 'gray-tcl)
  114. ; (set-mode-motion-handler 'dired-mode 'gray-line@)
  115. ; (set-mode-motion-handler 'gnus-group-mode 'gray-vline@)
  116. ; (set-mode-motion-handler 'gnus-summary-mode 'gray-vline@)
  117. ; (set-mode-motion-handler 'texinfo-mode 'gray-Texinfo)
  118. ; (setq default-motion-handler (find-motion-handler 'gray-thing))
  119. ;
  120. ;
  121. ; Revision 2.13.R  1994/08/08  19:47:34  Russell.Ritchie@gssec.bt.co.uk
  122. ; Made default handler be underline-thing, as most bold fonts seem to
  123. ; be greater in height than their corresponding normal versions,
  124. ; causing irritating screen flicker.
  125. ;
  126. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Molli/bosch changes;;;;;;;;;;;;;;;;;;;;;;;;
  127. ;
  128. ; Revision 3.2  1994/09/28  15:14:29  molli
  129. ; add   "(set-mode-motion-handler 'latex-mode   'raise-LaTeX)".    Barry
  130. ; Waraw's C/C++ mode is now changed to cc-mode ...
  131. ;
  132. ; Revision 3.1  1994/09/28  15:10:36  molli
  133. ; Initial revision
  134. ;
  135. ; Revision 2.15  1993/11/18  08:13:28  bosch
  136. ; Constant `mode-motion+-version' added.
  137. ; Minor bug fix in `tcl-forward-sexp1'.
  138. ;
  139. ; Revision 2.14  1993/10/29  20:04:59  bosch
  140. ; Minibuffer name matching improved.  Made `tcl-boundaries' smarter by
  141. ; use of new function `tcl-forward-sexp1'. `tcl-commands' list updated
  142. ; -- should be complete now.  A message is printed if the syntax scanner
  143. ; matched or failed for known tcl/tk commands.  Seperated `tcl-commands'
  144. ; from `tk-commands' -- `tk-commands' not yet complete.  New motion
  145. ; handler `raise-LaTeX' added, for tex-mode.
  146. ;
  147. ; Revision 2.13  1993/10/08  09:43:00  bosch
  148. ; New user option `mode-motion-setup-cut-and-paste-bindings'.  Function
  149. ; `mode-motion-copy/delete' now takes into account the primary and the
  150. ; motion selection.
  151. ;
  152. ; Revision 2.12  1993/10/08  09:08:46  bosch
  153. ; Avoid highlighting empty lines, even if
  154. ; `mode-motion-highlight-lines-when-behind' is non-nil.
  155.  
  156. ; Revision 2.12  1994/07/07  18:33:38  Russell.Ritchie@gssec.bt.co.uk
  157. ; Made list-motion-handlers and mode-motion-set-handler work in lemacs-19.10.
  158. ; 
  159. ; Revision 2.11  1993/09/20  08:29:15  bosch
  160. ; Code reorganized: variables declared before used.
  161. ; Compatibility hack patched again.
  162. ;
  163. ; Revision 2.10  1993/09/17  18:50:33  bosch
  164. ; Bug in the compatibility hack fixed. Call to `make-cursor' replaced by
  165. ; `x-pointer-cache'. Compatibility hack for Lemacs 19.8 removed.  Tcl
  166. ; motion handler improved (needs still some work).
  167. ;
  168. ; Revision 2.9  1993/09/15  17:52:53  bosch
  169. ; Compatibility patch for Lucid Emacs 19.8. tcl motion handler added.
  170. ;
  171. ; Revision 2.8  1993/08/27  15:17:07  bosch
  172. ; Select window conflict between motion handlers and process filters
  173. ; resolved by using `enqueue-eval-event' for selecting a different
  174. ; window (functions `mode-motion-track-pointer' and
  175. ; `mode-motion-highlight-with-handler' modified). This fixes the nasty
  176. ; bug that made GNUS hanging during NNTP activity while the mouse was
  177. ; moved.
  178. ;
  179. ; Revision 2.7  1993/08/27  12:50:10  bosch
  180. ; TeX and LaTeX motion handler generalized.  Motion handler
  181. ; `highlight-Texinfo' added.
  182. ;
  183. ; Revision 2.6  1993/06/24  11:58:52  bosch
  184. ; Mode motion+ support for pcl-cvs added. #undef syntax for C added.
  185. ;
  186. ; Revision 2.5  1993/06/09  12:04:31  bosch
  187. ; Delivery motion handlers for `c++-c-mode', `gnus-group-mode', and
  188. ; `gnus-summary-mode' added. Mode motion commands bound to copy/cut/past
  189. ; keys for Sun keyboards (f16, f18, f20). Comment added.
  190. ;
  191. ; Revision 2.4  1993/02/15  12:59:47  bosch
  192. ; Modifications sent by Tibor Polgar integrated:
  193. ; Optional parameter added to `mode-motion-copy/delete'.  User option
  194. ; `mode-motion-focus-on-window' added. It controls window selection for
  195. ; the motion handlers. Minor changes of the delivery motion handlers.
  196. ;
  197. ; Revision 2.3  1993/02/04  18:10:09  bosch
  198. ; User option `mode-motion-minibuffer-completion' added. It controls
  199. ; the minibuffer completion highlighting.
  200. ;
  201. ; Revision 2.2  1993/01/27  13:08:12  bosch
  202. ; Improved clearing of `sticky' mode-motion-extents when leaving screen
  203. ; or buffer.  Function `mode-motion-clear-extent' added.
  204. ; Highlight line mouse cursor is behind.
  205. ; `mode-motion-highlight-with-handler' now takes an event as argument.
  206. ; Cut and paste functions renamed and rewritten. Now they are called:
  207. ; `mode-motion-move', `mode-motion-delete', `mode-motion-copy',
  208. ; `mode-motion-copy-as-kill'.  Bug fixes in the C scanner stuff.
  209. ; Motion handler `underline-c' added.
  210. ;
  211. ; Revision 2.1  1993/01/19  18:29:58  bosch
  212. ; Scanner and motion handler for C syntax added.
  213. ; Function `set-default-motion-handler' added.
  214. ; Minor improvements on the `list-motion-handlers' interface done.
  215. ; Minor bug fixes.
  216. ;
  217. ; Revision 2.0 1993/01/14   19:17:29  bosch
  218. ; Lot of things rewritten and reorganized. This version fits in only
  219. ; one file (beside the required package thing.el).
  220. ;
  221. ; New basic features are:
  222. ;  - buffer, mode and default motion handlers
  223. ;  - easy composition of own motion handlers
  224. ;  - listing of motion handlers in tabular form
  225. ;  - menu interface for changing motion handlers
  226. ;  - only two  elisp files: mode-motion+.el, thing.el
  227. ; 
  228.  
  229. (require 'thing)
  230. (require 'mode-motion)
  231. (defconst mode-motion+-version "3.12")
  232.  
  233. ;;; This file defines a set of mouse motion handlers that do some
  234. ;;; highlighting of the text when the mouse moves over.
  235. ;;; An exhaustive list of the motion handlers defined in this file may be
  236. ;;; obtained with M-x list-motion-handlers.
  237. ;;; User Options and their Custommisation
  238. ;;;
  239. ;;; Mode-motion+ provides four user options, defined beyond. See their
  240. ;;; documentation string to know what they are good for. If you want
  241. ;;; to modify their default values, just setq them in your ~/.emacs.
  242.  
  243. (defvar mode-motion+-religion nil ; Initialised in mode-motion-init.
  244.   "*Default highlight religion: one of bold, gray, highlight, invert or underline.
  245.  
  246. Unless you setq this otherwise, it defaults to underline when
  247. (x-display-color-p) is non-nil and invert otherwise.
  248. Setting it to 'highlight should cause mode-motion+ extents to be
  249. indistinguishable from any other type of highlighted extent which may or may
  250. not be advisable, depending on your point of view.")
  251.  
  252. (defvar mode-motion-highlight-lines-when-behind t
  253.   "*If non-nil highlight the whole line if the mouse is past the end.")
  254.  
  255. (defvar mode-motion-focus-on-window 'follow-point
  256.   "*Controls whether moving the mouse into another window selects this window.
  257. The following values are possible:
  258.  
  259. nil      - Window selection isn't influenced at all by mode motion.
  260.  
  261. t      - Window selection always follows the mouse cursor. Copying
  262.         motion active regions doesn't work any longer between
  263.         different buffers.
  264.         
  265. any other - \(the default\) Window selection follows the mouse cursor if
  266.         the motion handler of the buffer under the mouse has the
  267.         follow-point property set. Useful for selecting line mode
  268.         buffers just by moving the mouse inside in order to
  269.         execute commands there. \(VM summary, GNUS Group and
  270.         Subject , DIRED, Buffer menu etc.\) 
  271.         Be aware: GNUS blocks with this option set when moving the 
  272.         mouse while retrieving headers or articles via the NNTP
  273.         service.")
  274.  
  275. (defvar mode-motion-setup-cut-and-paste-bindings t
  276.   "*If non-nil, bind commands to the Copy, Paste and Cut keys.")
  277.  
  278. ;;  Options sub-menu for mode-motion+
  279. (defvar mode-motion+-options-menu 
  280.   '("Motion Highlighting"
  281.     "For Current Buffer"
  282.     "---"
  283.     ["None"
  284.      (progn
  285.        (set-buffer-motion-handler (current-buffer) 'no-thing)
  286.        (mode-motion-clear-extent))
  287.      :style radio
  288.      :selected (eq (mode-motion+-buffer-handler-religion (current-buffer))
  289.            'no)
  290.      :active (mode-motion+-active-p)]
  291.     ["Bold"
  292.      (progn
  293.        (modify-buffer-motion-handler (current-buffer) 'bold))
  294.      :style radio
  295.      :selected (eq (mode-motion+-buffer-handler-religion (current-buffer))
  296.            'bold)
  297.      :active (mode-motion+-active-p)]
  298.     ["Underline"
  299.      (progn
  300.        (modify-buffer-motion-handler (current-buffer) 'underline))
  301.      :style radio
  302.      :selected (eq (mode-motion+-buffer-handler-religion (current-buffer))
  303.            'underline)
  304.      :active (mode-motion+-active-p)]
  305.     ["Gray"
  306.      (progn
  307.        (modify-buffer-motion-handler (current-buffer) 'gray))
  308.      :style radio
  309.      :selected (eq (mode-motion+-buffer-handler-religion (current-buffer))
  310.            'gray)
  311.      :active (mode-motion+-active-p)]
  312.     ["Highlight"
  313.      (progn
  314.        (modify-buffer-motion-handler (current-buffer) 'highlight))
  315.      :style radio
  316.      :selected (eq (mode-motion+-buffer-handler-religion (current-buffer))
  317.            'highlight)
  318.      :active (mode-motion+-active-p)]
  319.     ["Invert"
  320.      (progn
  321.        (modify-buffer-motion-handler (current-buffer) 'invert))
  322.      :style radio
  323.      :selected (eq (mode-motion+-buffer-handler-religion (current-buffer))
  324.            'invert)
  325.      :active (mode-motion+-active-p)]
  326.     "---"
  327.     "For Current Mode"
  328.     "---"
  329.     ["None"
  330.      (progn
  331.        (set-mode-motion-handler major-mode 'no-thing)
  332.        (mode-motion-clear-extent))
  333.      :style radio
  334.      :selected (eq (mode-motion+-mode-handler-religion major-mode) 'no)
  335.      :active (mode-motion+-active-p)]
  336.     ["Bold"
  337.      (progn
  338.        (modify-mode-motion-handler major-mode 'bold))
  339.      :style radio
  340.      :selected (eq (mode-motion+-mode-handler-religion major-mode) 'bold)
  341.      :active (mode-motion+-active-p)]
  342.     ["Underline"
  343.      (progn
  344.        (modify-mode-motion-handler major-mode 'underline))
  345.      :style radio
  346.      :selected (eq (mode-motion+-mode-handler-religion major-mode) 'underline)
  347.      :active (mode-motion+-active-p)]
  348.     ["Gray"
  349.      (progn
  350.        (modify-mode-motion-handler major-mode 'gray))
  351.      :style radio
  352.      :selected (eq (mode-motion+-mode-handler-religion major-mode) 'gray)
  353.      :active (mode-motion+-active-p)]
  354.     ["Highlight"
  355.      (progn
  356.        (modify-mode-motion-handler major-mode 'highlight))
  357.      :style radio
  358.      :selected (eq (mode-motion+-mode-handler-religion major-mode) 'highlight)
  359.      :active (mode-motion+-active-p)]
  360.     ["Invert"
  361.      (progn
  362.        (modify-mode-motion-handler major-mode 'invert))
  363.      :style radio
  364.      :selected (eq (mode-motion+-mode-handler-religion major-mode) 'invert)
  365.      :active (mode-motion+-active-p)]
  366.     "---"
  367.     "For All"
  368.     "---"
  369.     ["None"
  370.      (progn
  371.        (setq mode-motion+-religion 'no)
  372.        (mode-motion-init-handlers-according-to-religion 'force)
  373.        (mode-motion-clear-extent))
  374.      :style radio
  375.      :selected (eq mode-motion+-religion 'no)
  376.      :active (mode-motion+-active-p)]
  377.     ["Bold"
  378.      (progn
  379.        (setq mode-motion+-religion 'bold)
  380.        (mode-motion-init-handlers-according-to-religion 'force))
  381.      :style radio
  382.      :selected (eq mode-motion+-religion 'bold)
  383.      :active (mode-motion+-active-p)]
  384.     ["Underline"
  385.      (progn
  386.        (setq mode-motion+-religion 'underline)
  387.        (mode-motion-init-handlers-according-to-religion 'force))
  388.      :style radio
  389.      :selected (eq mode-motion+-religion 'underline)
  390.      :active (mode-motion+-active-p)]
  391.     ["Gray"
  392.      (progn
  393.        (setq mode-motion+-religion 'gray)
  394.        (mode-motion-init-handlers-according-to-religion 'force))
  395.      :style radio
  396.      :selected (eq mode-motion+-religion 'gray)
  397.      :active (mode-motion+-active-p)]
  398.     ["Highlight"
  399.      (progn
  400.        (setq mode-motion+-religion 'highlight)
  401.        (mode-motion-init-handlers-according-to-religion 'force))
  402.      :style radio
  403.      :selected (eq mode-motion+-religion 'highlight)
  404.      :active (mode-motion+-active-p)]
  405.     ["Invert"
  406.      (progn
  407.        (setq mode-motion+-religion 'invert)
  408.        (mode-motion-init-handlers-according-to-religion 'force))
  409.      :style radio
  410.      :selected (eq mode-motion+-religion 'invert)
  411.      :active (mode-motion+-active-p)]
  412.     "---"
  413.     ["Minibuffer highlighting" (setq mode-motion-use-minibuffer-motion-handler
  414.                      (not mode-motion-use-minibuffer-motion-handler))
  415.      :style toggle :selected mode-motion-use-minibuffer-motion-handler]
  416.      
  417.     ["Customize..."
  418.      (list-motion-handlers)
  419.      t
  420.      ;;     nil
  421.      ]
  422.      ["Revert Customization"
  423.      (call-interactively 'mode-motion+-motion-hook-revert)
  424.      (and (boundp 'mode-motion+-previous-hook) mode-motion+-previous-hook)
  425.      ])
  426.   "Menu for changing mode-motion+ religion and other things.")
  427.  
  428. (defun mode-motion+-active-p ()
  429.   (cond ((symbolp mode-motion-hook)
  430.      (eq mode-motion-hook 'mode-motion+-highlight))
  431.     ((listp mode-motion-hook)
  432.      (memq 'mode-motion+-highlight mode-motion-hook))
  433.     (t nil)))
  434.      
  435. (defun mode-motion+-buffer-handler-religion (buffer)
  436.   (let* ((current-handler-name (symbol-name (motion-handler-name
  437.                          (get-current-motion-handler))))
  438.      (religion-name (substring current-handler-name
  439.                    0
  440.                    (string-match "-" current-handler-name))))
  441.     (intern-soft religion-name)))
  442.  
  443. (defun mode-motion+-mode-handler-religion (buffer)
  444.   (let* ((mode-handler (or (get major-mode 'mode-motion-handler)
  445.                default-motion-handler))
  446.      (current-handler (symbol-name (motion-handler-name mode-handler)))
  447.      (religion (substring current-handler
  448.                   0
  449.                   (string-match "-" current-handler))))
  450.     (intern-soft religion)))
  451.  
  452. (defun modify-buffer-motion-handler (buffer religion)
  453.   (let* ((current-handler (symbol-name (motion-handler-name
  454.                          (get-current-motion-handler))))
  455.      (suffix (substring current-handler
  456.                 (string-match "-" current-handler))))
  457.     (set-buffer-motion-handler buffer
  458.                    (intern-soft (concat (symbol-name religion)
  459.                             suffix)))))
  460.  
  461. (defun modify-mode-motion-handler (mode religion)
  462.   (let* ((mode-handler (or (get major-mode 'mode-motion-handler)
  463.                default-motion-handler))
  464.      (current-handler (symbol-name (motion-handler-name mode-handler)))
  465.      (suffix (substring current-handler
  466.                 (string-match "-" current-handler))))
  467.     (set-mode-motion-handler mode (intern-soft (concat (symbol-name
  468.                             religion)
  469.                                suffix)))))
  470.  
  471. ;;;; This does not work.  I would like to be able to modify in-place
  472. ;;;; the non-selectable items, but I don't know how.
  473. ;;;; --paquette, Wed Mar  8 23:32:32 1995 (Marc Paquette) 
  474. ;;; Sensitize the mode motion+ options submenu, a la
  475. ;;; sensitize-file-and-edit-menus-hook.
  476. (defun mode-motion+-sensitize-options-menu-hook ()
  477.   "Hook function that will adjust title items in the mode-motion+ submenu in Options"
  478.   (let* ((mm+-menu (cdr (car (find-menu-item
  479.                   current-menubar
  480.                   '("Options" "Motion Highlighting")))))
  481.      (buffer-item (find-menu-item mm+-menu '("For Current Buffer")))
  482.      (mode-item (find-menu-item mm+-menu '("For Current Mode"))))
  483.     (setcar buffer-item (format "For Buffer `%s'" (buffer-name nil)))
  484.     (setcar mode-item (format "For Mode `%s'" major-mode))
  485.     nil))
  486.  
  487. ;;(add-hook 'activate-menubar-hook 'mode-motion+-sensitize-options-menu-hook)
  488.   
  489.  
  490. ;;  Motion Handler Format:
  491. ;;      
  492. ;; A motion handler is vector with the following format 
  493. ;; [<name>                    - a symbol
  494. ;;  <region computing function> - a function or name of function 
  495. ;;                  that returns (<startpos> . <endpos>) 
  496. ;;                  or nil.
  497. ;;  <face or face name>        - as it says ...
  498. ;;  <highlight-p>        - non-nil means that the motion extent
  499. ;;                  will be highlighted using the function 
  500. ;;                  `highlight-extent'
  501. ;;  <follow-point-p>        - non-nil means that point will follow the
  502. ;;                  mouse motion. 
  503. ;; ]
  504.  
  505. ;; accessor functions
  506. (defsubst motion-handler-name (handler) (aref handler 0))
  507. (defsubst motion-handler-boundary-function (handler) (aref handler 1))
  508. (defsubst motion-handler-face (handler) (aref handler 2))
  509. (defsubst motion-handler-highlight (handler) (aref handler 3))
  510. (defsubst motion-handler-follow-point (handler) (aref handler 4))
  511.  
  512. ;; modifier functions
  513. (defsubst set-motion-handler-boundary-function (handler x) (aset handler 1 x))
  514. (defsubst set-motion-handler-face (handler x) (aset handler 2 x))
  515. (defsubst set-motion-handler-highlight (handler x) (aset handler 3 x))
  516. (defsubst set-motion-handler-follow-point (handler x) (aset handler 4 x))
  517.  
  518. ;; Internal global variables 
  519. (defvar motion-handler-alist ()
  520.   "Alist with entries of the form \(<name> . <handler>\).")
  521.  
  522. ;; Minibuffer motion handler
  523. (defvar mode-motion-use-minibuffer-motion-handler t
  524.   "*Enable mousable highlighting when the minibuffer is active. When false only extents with the
  525. highlight property are selectable (*Completion*)")
  526.  
  527. (defvar mode-motion-extent nil)
  528. (make-variable-buffer-local 'mode-motion-extent)
  529. (defvar buffer-motion-handler nil)
  530. (make-variable-buffer-local 'buffer-motion-handler)
  531. (defvar mode-motion-last-extent nil "The last used mode motion extent.")
  532. (defvar default-motion-handler nil)    ; Initialised in mode-motion-init.
  533.  
  534. ;; Creation of motion handlers
  535.  
  536. (defun find-motion-handler (name)
  537.   (or (symbolp name)
  538.       (setq name (intern-soft name)))
  539.   (cdr (assq name motion-handler-alist)))
  540.  
  541. ;; internal motion handler creator
  542. (defsubst make-motion-handler-internal 
  543.   (name boundary-function face highlight follow-cursor)
  544.   (vector name boundary-function (get-face face) highlight follow-cursor))
  545.  
  546. (defun make-motion-handler 
  547.   (name boundary-function &optional face highlight follow-cursor)
  548.   "Create a motion handler named NAME (a symbol or string) using REGION-FUNCTION.
  549.  
  550. REGION-FUNCTION is the function that computes the region to be highlighted. 
  551. Optional arguments are: 
  552.  
  553. FACE: A face or face name to be used to highlight the region computed
  554.       by REGION-FUNCTION.  'default is the default.
  555.       
  556. HIGHLIGHT: Flag that indicates whether the highlight attribute of the
  557.       mode-motion-extent should be set or not. If FACE is the default face, 
  558.       HIGHLIGHT defaults to t, otherwise to nil.
  559.  
  560. FOLLOW-CURSOR: Flag that indicates whether the cursor should follow
  561.       the mouse motion. Default is nil."
  562.  
  563.   ;; required arguments
  564.   (or name (error "motion handler name required."))
  565.   (or (symbolp name) 
  566.       (stringp name)
  567.       (error "motion handler name must be a string or symbol: %s" name))
  568.   (or boundary-function 
  569.       (error "motion handler region function required."))
  570.   (or (fboundp boundary-function)
  571.       (error "not a function: %s." boundary-function))
  572.   ;; defaults
  573.   (or face (setq face 'default))
  574.   
  575.   ;; store the mode motion handler on the 'mode-motion-handler property of
  576.   ;; its name symbol
  577.   (let ((old-handler (cdr (assq name motion-handler-alist)))
  578.     new-handler)
  579.     (if old-handler
  580.     (progn 
  581.       (set-motion-handler-boundary-function old-handler boundary-function)
  582.       (set-motion-handler-face old-handler (get-face face))
  583.       (set-motion-handler-highlight old-handler highlight)
  584.       (set-motion-handler-follow-point old-handler follow-cursor))
  585.       (setq motion-handler-alist 
  586.         (cons (cons name 
  587.             (setq new-handler (make-motion-handler-internal
  588.                        name
  589.                        boundary-function
  590.                        (get-face face)
  591.                        highlight
  592.                        follow-cursor)))
  593.           motion-handler-alist)))
  594.     (or old-handler new-handler)))
  595.  
  596. (defvar list-motion-handlers-buffer-to-customize nil
  597.   "Name of buffer from where list-motion-handlers was called.")
  598. (make-variable-buffer-local 'list-motion-handlers-buffer-to-customize)
  599. (defvar list-motion-handlers-buffer-mode nil
  600.   "Name of mode of buffer from where list-motion-handlers was called.")
  601. (make-variable-buffer-local 'list-motion-handlers-buffer-mode)
  602. ;; Listing available motion handlers in tabular form. 
  603.       
  604. (defvar basic-motion-handlers (list 'mode-motion-highlight-line
  605.                     'mode-motion-highlight-word
  606.                     'mode-motion-highlight-symbol
  607.                     'mode-motion-highlight-sexp)
  608.   "The basic motion handlers provided by the underlying XEmacs.")
  609.  
  610. (defun list-motion-handlers ()
  611.   "Display a list of available motion handlers.
  612. The listing is in tabular form and contains the following columns:
  613. NAME: the motion handlers name,
  614. BOUNDARY FUNCTION: the name of the funtion used to compute the text  
  615.    highlighted by the motion handler,
  616. FACE: the face used to highlight the text.
  617.  
  618. Additionally, the following flags are used at the beginning of each line:
  619. `*' Marks the motion handler current to the buffer this functions was called 
  620.     from.
  621. `H' Force highlighting of the selected text.
  622. `F' Make point follow the mouse cursor as it moves."
  623.   (interactive)
  624.   (let ((current-handler (get-current-motion-handler))
  625.     (buffer (current-buffer))
  626.     (buffer-mode major-mode)
  627.     (bmmh (if (symbolp mode-motion-hook)
  628.           (car (memq mode-motion-hook basic-motion-handlers))
  629.         (if (and (listp mode-motion-hook) 
  630.              (equal 1 (length mode-motion-hook)))
  631.             (car (memq (car mode-motion-hook)
  632.                    basic-motion-handlers))))))
  633.     (save-excursion
  634.       (with-output-to-temp-buffer "*Mouse Motion Handlers*"
  635.     (let ((truncate-lines t))
  636.       (set-buffer "*Mouse Motion Handlers*")
  637.       (setq list-motion-handlers-buffer-to-customize buffer)
  638.       (setq list-motion-handlers-buffer-mode buffer-mode)
  639.       (let ((pos1 5)
  640.         (pos2 25)
  641.         (pos3 50)
  642.         (handlers 
  643.          (sort 
  644.           (mapcar 'cdr motion-handler-alist)
  645.           '(lambda (x y)
  646.              (string<
  647.               (symbol-name (motion-handler-boundary-function x))
  648.               (symbol-name (motion-handler-boundary-function y)))))))
  649.         (if bmmh
  650.         (let ((i 1)
  651.               (fw (frame-width)))
  652.           (while (< i fw)
  653.             (princ "*")
  654.             (setq i (1+ i)))
  655.           (princ "\nNote: this buffer is not using mode-motion+.\n\n")
  656.           (princ "It's using the `")
  657.           (princ bmmh)
  658.           (princ "' motion handler which claims it's:\n")
  659.           (insert (documentation bmmh))
  660.           (princ "\nSetting this motion handler will be irrevocable from this interface\n(but only for duration of this XEmacs session).\n")
  661.           (setq i 1)
  662.           (while (< i fw)
  663.             (princ "*")
  664.             (setq i (1+ i)))
  665.           (terpri)))
  666.         (princ "     NAME                BOUNDARY FUNCTION        FACE\n")
  667.         (princ "     ----                -----------------        ----\n")
  668.         (mapcar 
  669.          #'(lambda (handler)
  670.          (let ((line-start (point)))
  671.            (princ (if (and (not bmmh) (eq handler current-handler))
  672.                   "*" " "))
  673.            (princ (if (eq handler default-motion-handler) "D" " "))
  674.            (princ (if (motion-handler-highlight handler) "H" " "))
  675.            (princ (if (motion-handler-follow-point handler) "F" " "))
  676.            (indent-to-column pos1 1)
  677.            (princ (motion-handler-name handler))
  678.            (indent-to-column pos2 1)
  679.            (princ (motion-handler-boundary-function handler))
  680.            (indent-to-column pos3)
  681.            (let ((face-start (point)))
  682.              (princ (face-name (motion-handler-face handler)))
  683.              (let ((line-extent (make-extent line-start face-start))
  684.                (face-extent (make-extent face-start (point))))
  685.              (set-extent-face face-extent
  686.                       (motion-handler-face handler))
  687.              (set-extent-property
  688.               face-extent
  689.               'mode-motion-handler (motion-handler-name handler))
  690.              (set-extent-property
  691.               line-extent
  692.               'mode-motion-handler (motion-handler-name handler))
  693.              (set-extent-property line-extent 'highlight t)))
  694.          (terpri)))
  695.          handlers)
  696.         (princ (format "
  697. Flags:    `D' the default motion handler
  698.            `H' handler with highlighting
  699.     `F' handler with `following' property
  700.     `*' the motion handler of buffer \"%s\""
  701.                list-motion-handlers-buffer-to-customize))))
  702.     (local-set-key 'button3 'mode-motion-set-handler)
  703.     (setq buffer-read-only t)))))
  704.  
  705. (defun mode-motion-set-handler (event)
  706.   (interactive "@e")
  707.   (let* ((handler (or (extent-property
  708.                (extent-at (event-point event) (current-buffer)
  709.                   'mode-motion-handler)
  710.                'mode-motion-handler)
  711.               (error "Click on highlighted line to select a handler")))
  712.      (menu (list
  713.         (format "Make `%s' the Motion Handler of :" handler)
  714.         (vector (format "Buffer %s"
  715.                 list-motion-handlers-buffer-to-customize)
  716.             (` (set-buffer-motion-handler
  717.                 '(, list-motion-handlers-buffer-to-customize)
  718.                 '(, handler))) t)
  719.         (vector "Another Buffer..."
  720.             (` (motion-handler-list-set-buffer-handler
  721.                 '(, handler))) t)
  722.         "---"
  723.         (vector (format "Mode %s"
  724.                 list-motion-handlers-buffer-mode)
  725.             (` (progn
  726.                  (set-mode-motion-handler
  727.                   '(, list-motion-handlers-buffer-mode)
  728.                   '(, handler))
  729.                  (save-excursion
  730.                    (mapcar
  731.                 (function
  732.                  (lambda (buf)
  733.                    (set-buffer buf)
  734.                    (and (eq
  735.                      '(, list-motion-handlers-buffer-mode)
  736.                      major-mode)
  737.                     (mode-motion+-hook-install buf t))))
  738.                        (buffer-list))))) t)
  739.         (vector "Another Mode..."
  740.             (` (motion-handler-list-set-mode-handler
  741.                 '(, handler))) t)
  742.         "---"
  743.         (vector "Default Motion Handler"
  744.             (` (set-default-motion-handler '(, handler))) t))))
  745.     (popup-menu menu)))
  746.  
  747. (defun motion-handler-list-set-buffer-handler (handler)
  748.   (let ((buffer (read-buffer-name 
  749.          (format "Make `%s' the motion handler of buffer: " handler)
  750.          (buffer-name list-motion-handlers-buffer-to-customize))))
  751.     (set-buffer-motion-handler buffer handler)
  752.     (save-excursion
  753.       (set-buffer buffer)
  754.       (and (not (cond ((listp mode-motion-hook)
  755.                (memq 'mode-motion+-highlight mode-motion-hook))
  756.               ((symbolp mode-motion-hook)
  757.                (eq 'mode-motion+-highlight mode-motion-hook))
  758.               (t t)))
  759.        (y-or-n-p (format "Augment the default mode motion hook for `%s'? "
  760.                  (buffer-name nil)))
  761.        (mode-motion+-hook-install buffer t)))))
  762.  
  763. (defvar mode-motion+-previous-hook nil
  764.   "Value of previous `mode-motion-hook' in current buffer.")
  765. (make-variable-buffer-local 'mode-motion+-previous-hook)
  766.  
  767. (defun motion-handler-list-set-mode-handler (handler)
  768.   (let ((mode (intern (completing-read
  769.         (format "Make `%s' the motion handler of mode: " handler)
  770.         obarray
  771.         'fboundp
  772.         t    
  773.         (symbol-name list-motion-handlers-buffer-mode)))))
  774.     (set-mode-motion-handler mode handler)
  775.   (save-excursion
  776.     (mapcar (function
  777.          (lambda (buf)
  778.            (set-buffer buf)
  779.            (and (eq mode major-mode)
  780.             (mode-motion+-hook-install buf t))))
  781.         (buffer-list)))))
  782.  
  783. (defun mode-motion+-hook-install (&optional buffer remove-highlight-line-p)
  784.   "Add `mode-motion+-highlight' to the BUFFER `mode-motion-hook'.
  785. If the optional second arg REMOVE-HIGHLIGHT-LINE-P is t, remove
  786. `mode-motion-highlight-line' from `mode-motion-hook'.
  787. See `mode-motion+-hook-uninstall' for reverting this operation."
  788.   (interactive "bInstall mode-motion+ hook for buffer :
  789. XRemove highlight-line from hook ? :")
  790.   ;; Check for the mode-motion-hook value to make sure it's under
  791.   ;; the control of mode-motion+.
  792.   ;; The reasonning here is that if the user went trough the hassles
  793.   ;; of list-motion-handlers (or if he's calling this directly from
  794.   ;; his .emacs) , he is prepared to give up on the current
  795.   ;; mode-motion-hook.
  796.   ;; However, we keep the previous hook value in a buffer-local
  797.   ;; variable: it will be then possible to revert to the old motion
  798.   ;; handling behavior with `mode-motion+-hook-uninstall'.
  799.   ;; --paquette, Mon Feb 27 08:54:30 1995 (Marc Paquette)
  800.   (setq buffer (or buffer (current-buffer)))
  801.   ;; force the uninstall of mode-motion-highlight since if its second
  802.   ;; you'll never see ours.
  803.   (setq remove-highlight-line-p t)
  804.   (save-excursion
  805.     (set-buffer buffer)
  806.     (if (boundp 'mode-motion-hook)
  807.     (progn
  808.       (setq mode-motion+-previous-hook
  809.         (cond ((sequencep mode-motion-hook)
  810.                (copy-sequence mode-motion-hook))
  811.               (t mode-motion-hook)))
  812.       ;; Make sure that the mode-motion+-highlight is not saved in
  813.       ;; the variable, otherwise, we could not revert back to the
  814.       ;; "factory settings" after having played with different
  815.       ;; handlers
  816.       ;; --paquette, Mon Feb 27 08:54:21 1995 (Marc Paquette)
  817.       (remove-hook 'mode-motion+-previous-hook 'mode-motion+-highlight)))
  818.     (add-hook 'mode-motion-hook 'mode-motion+-highlight)
  819.     (and remove-highlight-line-p
  820.      ;; Remove the standard mode-motion-highlight hook because we
  821.      ;; provide an alternative to this.  I don't use setq here because
  822.      ;; something else could be hooked to mode-motion-hook.
  823.      ;; --paquette, Mon Feb 27 08:53:51 1995 (Marc Paquette)
  824.      (remove-hook 'mode-motion-hook 'mode-motion-highlight-line))
  825.     (and mode-motion-extent
  826.      (delete-extent mode-motion-extent)
  827.      (setq mode-motion-extent nil))
  828.     ;; Try to make this installed for any buffer of this mode
  829.     (let ((this-mode-hook (intern-soft (concat (symbol-name major-mode)
  830.                            "-hook"))))
  831.       (and (boundp this-mode-hook)
  832.        (if remove-highlight-line-p
  833.            (add-hook this-mode-hook
  834.              #'(lambda () (mode-motion+-hook-install nil t))
  835.              'append)
  836.          (add-hook this-mode-hook 'mode-motion+-hook-install 'append)))))
  837.   mode-motion-hook)
  838.  
  839. (defun mode-motion+-hook-uninstall (buffer)
  840.   "Restore the value of `mode-motion-hook' in BUFFER to what it was at the time `mode-motion+-hook-install' was called.
  841. See also `mode-motion+-hook-install'."
  842.   (interactive "bRestore `mode-motion-hook' of buffer :")
  843.   ;; Check for the mode-motion-hook value to make sure it's under
  844.   ;; the control of mode-motion+.
  845.   ;; The reasonning here is that if the user went trough the hassles
  846.   ;; of list-motion-handlers (or if he's calling this directly from
  847.   ;; his .emacs) , he is prepared to give up on the current
  848.   ;; mode-motion-hook.
  849.   ;; However, we keep the previous hook value in a buffer-local
  850.   ;; variable: it will be then possible to revert to the old motion
  851.   ;; handling behavior with `mode-motion+-hook-uninstall'.
  852.   ;; --paquette, Mon Feb 27 08:54:30 1995 (Marc Paquette)
  853.   (save-excursion
  854.     (set-buffer buffer)
  855.     (and mode-motion-extent
  856.      (delete-extent mode-motion-extent)
  857.      (setq mode-motion-extent nil))
  858.     (if (boundp 'mode-motion+-previous-hook)
  859.     (progn
  860.       (setq mode-motion-hook mode-motion+-previous-hook)
  861.       (setq mode-motion+-previous-hook nil)
  862.       (let ((this-mode-hook (intern-soft (concat (symbol-name major-mode)
  863.                              "-hook"))))
  864.         (and (boundp this-mode-hook)
  865.          (remove-hook this-mode-hook 'mode-motion+-hook-install))))
  866.       (error "No previous value for mode-motion-hook")))
  867.   mode-motion-hook)
  868.  
  869. (defun mode-motion+-motion-hook-revert (&optional buffer-only-p buffer mode)
  870.   "Revert the `mode-motion-hook' to its original value.
  871. With optional arg BUFFER-ONLY-P non-nil, only revert in BUFFER
  872. \(defaults to `\(current-buffer\)'\); otherwise, revert for all existing
  873. buffers of MODE \(defaults to `major-mode' of BUFFER\)."
  874.   (interactive
  875.     (let* ((buffer-only-p
  876.        (y-or-n-p "Revert mode-motion-hook only for current buffer ? "))
  877.        (buffer (if buffer-only-p
  878.                (current-buffer)
  879.              (get-buffer (read-buffer-name
  880.                   "Revert mode-motion-hook of buffer : "
  881.                   (buffer-name (current-buffer))))))
  882.        (mode (if buffer-only-p
  883.              (save-excursion
  884.                (set-buffer buffer)
  885.                major-mode)
  886.            (intern-soft (completing-read "Major mode: "
  887.                          obarray
  888.                          'fboundp    
  889.                          nil 
  890.                          (symbol-name major-mode))))))
  891.       (list buffer-only-p buffer mode)))
  892.   (if buffer-only-p
  893.       (mode-motion+-hook-uninstall buffer)
  894.     (save-excursion
  895.       (mapcar (function
  896.            (lambda (buf)
  897.          (set-buffer buf)
  898.          (and (eq mode major-mode)
  899.               (mode-motion+-hook-uninstall buf))))
  900.           (buffer-list)))))
  901.   
  902.  
  903. ;; Setting buffer, mode and default motion handlers
  904.  
  905. (defun set-buffer-motion-handler (buffer handler-name)
  906.   "Make the motion handler named HANDLER-NAME (a symbol) the buffer
  907. motion handler of BUFFER.  If HANDLER-NAME is nil, the corresponding
  908. buffer motion handler is removed.  If HANDLER-NAME isn't the name of a
  909. known motion handler, an error is signaled. When called interactively,
  910. completion is provided for available buffers and motion handlers.
  911.  
  912.     1.\) buffer motion handler
  913.     2.\) mode motion handler
  914.     3.\) default motion handler"
  915.   (interactive (list (read-buffer-name "Set motion handler of buffer: "
  916.                        (buffer-name (current-buffer)))
  917.              (read-motion-handler-name)))
  918.  
  919.   ;; kill old mode motion extent, because the new handler
  920.   ;; might want to initialize it differently
  921.   (if mode-motion-extent 
  922.       (progn 
  923.     (detach-extent mode-motion-extent)
  924.     (setq mode-motion-extent nil)))
  925.   (or buffer (setq buffer (current-buffer)))
  926.   (or (get-buffer buffer)
  927.       (error "No such buffer: %s" buffer))
  928.   (save-excursion 
  929.     (set-buffer buffer)
  930.     (setq buffer-motion-handler
  931.       ;; remove it if `nil'
  932.       (and handler-name
  933.            ;; set the handler if known
  934.            (or (find-motion-handler handler-name)
  935.            ;; error otherwise
  936.            (error "Not a known motion handler: %s"
  937.               handler-name)))))
  938.   (if (interactive-p)
  939.       (if handler-name
  940.       (message "Motion handler for buffer %s is `%s'." 
  941.            (current-buffer) handler-name)
  942.       (message "Motion handler removed for buffer %s." 
  943.            (current-buffer))))
  944.   handler-name)
  945.  
  946. (defun read-buffer-name (prompt &optional initial-input)
  947.   (completing-read prompt
  948.            (mapcar #'(lambda (buf) (list (buffer-name buf)))
  949.                (buffer-list))
  950.            ;; don't take buffers that start with a blank
  951.            #'(lambda (list) (not (eq (aref (car list) 0) ? )))
  952.            t
  953.            initial-input))
  954.  
  955. (defun set-mode-motion-handler (mode handler-name)
  956.   "Make the motion handler named HANDLER-NAME (a symbol) the mode motion
  957. handler for all buffers with major-mode MODE.  If HANDLER-NAME is nil,
  958. the corresponding mode motion handler is removed.  If HANDLER-NAME
  959. isn't the name of a known motion handler, an error is signaled. When
  960. called interactively, completion is provided for available motion
  961. handlers.
  962.  
  963.     1.\) buffer motion handler
  964.     2.\) mode motion handler
  965.     3.\) default motion handler"
  966.   (interactive (list (intern (completing-read "Major mode: "
  967.                           obarray
  968.                           'fboundp    
  969.                           nil 
  970.                           (symbol-name major-mode)))
  971.              (read-motion-handler-name)))
  972.   ;; kill old mode motion extent, because the new handler
  973.   ;; might want to initialize it differently
  974.   (if mode-motion-extent 
  975.       (progn 
  976.     (detach-extent mode-motion-extent)
  977.     (setq mode-motion-extent nil)))
  978.   (put mode 'mode-motion-handler 
  979.     ;; remove it if `nil'
  980.     (and handler-name
  981.          ;; set the handler if known
  982.          (or (find-motion-handler handler-name)
  983.          ;; error otherwise
  984.          (error "Not a known mode motion handler: %s" handler-name))))
  985.   (if (interactive-p)
  986.       (if handler-name
  987.       (message "Motion handler for %s is `%s'." mode handler-name)
  988.       (message "Mode motion handler for %s removed." mode)))
  989.   handler-name)
  990.  
  991. (defun set-default-motion-handler (handler-name)
  992.   "Make the motion handler named HANDLER-NAME (a symbol) the default.
  993.  
  994. If HANDLER-NAME is nil, the current default motion handler is removed.  If
  995. HANDLER-NAME isn't the name of a known motion handler, an error is
  996. signalled. When called interactively, completion is provided for available
  997. motion handlers.
  998.  
  999. The motion handler used in a given buffer is determined by the following
  1000. most-specific first list: buffer motion handler, mode motion handler, default
  1001. motion handler." 
  1002.   (interactive (list (read-motion-handler-name)))
  1003.   ;; kill old mode motion extent, because the new handler
  1004.   ;; might want to initialize it differently
  1005.   (if mode-motion-extent 
  1006.       (progn 
  1007.     (detach-extent mode-motion-extent)
  1008.     (setq mode-motion-extent nil)))
  1009.   (setq default-motion-handler
  1010.     ;; remove it if `nil'
  1011.     (and handler-name
  1012.          ;; set the handler if known
  1013.          (or (find-motion-handler handler-name)
  1014.          ;; error otherwise
  1015.          (error "Not a known motion handler: %s" handler-name))))
  1016.   (if (interactive-p)
  1017.       (if handler-name
  1018.       (message "Default motion handler is `%s'." handler-name)
  1019.       (message "Default motion handler removed.")))
  1020.   handler-name)
  1021.  
  1022. (defun read-motion-handler-name ()
  1023.   (intern-soft (completing-read "Motion handler: "
  1024.                 (mapcar #'(lambda (entry)
  1025.                         (list (symbol-name (car entry))))
  1026.                     motion-handler-alist)
  1027.                 nil t)))
  1028.  
  1029. ;; clear the last active motion extent when leaving a frame.
  1030. (defun mode-motion-clear-extent (&optional extent)
  1031.   "Clear EXTENT, i.e. make it have no visible effects on the frame.
  1032. EXTENT defaults to the current buffer's mode-motion-extent."
  1033.   (or extent (setq extent mode-motion-extent))
  1034.   (and extent 
  1035.        (extent-live-p extent)
  1036.        (not (extent-detached-p extent))
  1037.        (extent-buffer extent)
  1038.        (buffer-name (extent-buffer extent))
  1039.        (progn 
  1040.      ;; unhighlight it 
  1041.      (highlight-extent extent nil)
  1042.      ;; make it span a region that isn't visible and selectable
  1043.      ;; Can this be done more elegantly? 
  1044.      (detach-extent extent))))
  1045.  
  1046. (defun mode-motion-clear-last-extent (&optional frame)
  1047.   "Clear the mode-motion-last-extent."
  1048.   (or (popup-menu-up-p) (mode-motion-clear-extent mode-motion-last-extent)))
  1049.  
  1050. (defun mode-motion+-highlight (event)
  1051.   "Highlight the thing under the mouse using a mode-specfic motion handler.
  1052. See list-motion-handlers for more details."
  1053.   (mode-motion-clear-last-extent)
  1054.   (and (event-buffer event)
  1055.        (cond ((and mouse-grabbed-buffer
  1056.            ;; first try to do minibuffer specific highlighting
  1057.            (find-motion-handler 'minibuffer)
  1058.            (let ((mode-motion-highlight-lines-when-behind nil))
  1059.              (and (event-point event)
  1060.               (or (extent-at (event-point event)
  1061.                      (event-buffer event) 'highlight)
  1062.                   (mode-motion-highlight-with-handler
  1063.                    (find-motion-handler 'minibuffer) event))))))
  1064.          (t (mode-motion-highlight-with-handler
  1065.          (get-current-motion-handler) event))))
  1066.   ;; Return nil since now this is used as a hook, and we want to let
  1067.   ;; any other hook run after us.
  1068.   nil)
  1069.  
  1070. (defun get-current-motion-handler ()
  1071.   (or (and (boundp 'buffer-motion-handler) buffer-motion-handler)
  1072.       (get major-mode 'mode-motion-handler)
  1073.       default-motion-handler))
  1074.  
  1075. (defun mode-motion-highlight-with-handler (handler event)
  1076.   ;; Perform motion highlighting using HANDLER. Information about the
  1077.   ;; current mouse position is taken form EVENT. 
  1078.   (and handler
  1079.        (let ((point (event-point event))
  1080.          (buffer (event-buffer event))
  1081.          (window (event-window event))
  1082.          (window-config (current-window-configuration))
  1083.          (buffer-save (current-buffer))
  1084.          (point-save (point))
  1085.          region)
  1086.      ;; save-window-excursion and restore buffer
  1087.      (unwind-protect
  1088.          (progn
  1089.            (and buffer
  1090.             (set-buffer buffer)
  1091.             (select-window window))
  1092.        
  1093.            ;; kludge: if point = end-of-window, then probably the mouse
  1094.            ;; is actually between the last line and the modeline.  In
  1095.            ;; this case move point to back one
  1096.            (and point
  1097.             (not (< point (window-end window)))
  1098.             (setq point (1- point)))
  1099.            ;; Create a new mode-motion-extent if there isn't one 
  1100.            ;; (or a destroyed one)
  1101.            (if (and (extent-live-p mode-motion-extent)
  1102.             (extent-buffer mode-motion-extent))
  1103.            ()
  1104.          (setq mode-motion-extent (make-extent nil nil buffer))
  1105.          (set-extent-priority mode-motion-extent 1))
  1106.            (if (and 
  1107.             ;; compute the region to be highlighted
  1108.             (setq region
  1109.               (if point
  1110.                   ;; compute the mode-motion region using the 
  1111.                   ;; handlers boundary function
  1112.                   (condition-case nil;; c
  1113.                   (funcall
  1114.                    (motion-handler-boundary-function handler)
  1115.                    point)
  1116.                 ;; Messages that appear during computing the
  1117.                 ;; region may be displayed not done
  1118.                 ;; here because it's rather disturbing
  1119.                 (error
  1120.                  ;; (setq message (format "%s" (car (cdr c))))
  1121.                  nil))
  1122.                 ;; otherwise highlight the whole line mouse is
  1123.                 ;; behind but only if the line isn't empty
  1124.                 (if mode-motion-highlight-lines-when-behind
  1125.                 (unwind-protect
  1126.                     (progn 
  1127.                       ;; (message "%s" (event-window event))
  1128.                       (move-to-window-line
  1129.                        (if (< emacs-minor-version 12)
  1130.                        (- (event-y event) 
  1131.                           (nth 1 (window-edges window)))
  1132.                      (event-y event)))
  1133.                       (beginning-of-line)
  1134.                       (if (= (following-char) ?\n)
  1135.                       ;; empty line 
  1136.                       ()
  1137.                     (thing-region
  1138.                      (point)
  1139.                      (progn 
  1140.                        (end-of-line)
  1141.                        ;; for `follow-point' behavoir
  1142.                        (setq point (point))
  1143.                        ;; fetch also the newline, if any
  1144.                        ;; -- handy for copying >1 line
  1145.                        (if (eobp) point (1+ point))))))
  1146.                   (goto-char point-save)))))
  1147.             ;; (message "region: %s" region)
  1148.             ;; the region might be in reverse order. Stop in this case
  1149.             (<= (car region) (cdr region)))
  1150.            (progn 
  1151.              ;; set the extent face
  1152.              (set-extent-face
  1153.               mode-motion-extent (motion-handler-face handler))
  1154.              ;; set the new boundary
  1155.              (set-extent-endpoints 
  1156.               mode-motion-extent (car region) (cdr region))
  1157.              ;; highlight if required
  1158.              (set-extent-property mode-motion-extent 'highlight
  1159.                       (motion-handler-highlight handler))
  1160.              (highlight-extent mode-motion-extent
  1161.                        (motion-handler-highlight handler))
  1162.              ;; make point follow the mouse or point to the beginning
  1163.              ;; of the line do not move the cursor if a mark is set
  1164.              (cond ((and (motion-handler-follow-point handler)
  1165.                  (not (mark)))
  1166.                 (goto-char point)
  1167.                 ;; kludge to keep the cursor out the way
  1168.                 (if (or (eq (motion-handler-boundary-function
  1169.                      handler)
  1170.                     'line-boundaries)
  1171.                     (eq (motion-handler-boundary-function
  1172.                      handler)
  1173.                     'visible-line-boundaries))
  1174.                 (beginning-of-line))))
  1175.              (if (and mode-motion-focus-on-window
  1176.                   (or (eq mode-motion-focus-on-window t)
  1177.                   (motion-handler-follow-point handler)))
  1178.              ;; Select the current window FROM OUTSIDE the
  1179.              ;; `save-window-excursion' that surrounds the call
  1180.              ;; to the current function. This also avoids
  1181.              ;; conflicts with running process filters.
  1182.              (enqueue-eval-event 'select-window (selected-window)))
  1183.              ;; snap in effect, but it ain't yet workin'
  1184.              ;; (message "X: %sl; Y: %s"(event-x event)(event-y event))
  1185.              ;; (and motion-handler-snap-in
  1186.              ;;    (set-mouse-position
  1187.              ;;    (window-frame (event-window event))
  1188.              ;;    (event-x event)
  1189.              ;;    (event-y event)))
  1190.              (setq mode-motion-last-extent mode-motion-extent)
  1191.              ;; signal success
  1192.              t)
  1193.          ;; signal failiure
  1194.          nil))
  1195.        (set-window-configuration window-config)
  1196.        (set-buffer buffer-save)))))
  1197.  
  1198. ;; Motion Event debugging
  1199. ;;
  1200. ;; Useful to see what information is available from motion events
  1201.  
  1202. (defun debug-motion-handler (event)
  1203.    (let* ((window (event-window event))
  1204.       (frame (or (event-frame event) (selected-frame)))
  1205.       (buffer (and window (event-buffer event)))
  1206.       (point  (and buffer (event-point event))))
  1207.      (with-output-to-temp-buffer "*Debug Motion Handler Output*"
  1208.        (princ 
  1209.     (format "\
  1210.  Window: %s
  1211.  Frame: %s
  1212.  Buffer: %s
  1213.  (event-x, event-y): (%s, %s)
  1214.  (event-x-pixel, event-y-pixel): (%s, %s)
  1215.  Point: %s
  1216.  Timestamp: %s"
  1217.     window 
  1218.         frame 
  1219.         buffer 
  1220.         (event-x event) (event-y event) 
  1221.         (event-x-pixel event) (event-y-pixel event)
  1222.         point 
  1223.         (event-timestamp event))))))
  1224.  
  1225. ;(let ((mouse-motion-handler 'debug-motion-handler)
  1226. ;      (temp-buffer-show-function nil))
  1227. ;  (read-char))
  1228.  
  1229. ;; Set of copy/kill/move functions for usage with highlighted regions
  1230.  
  1231. (put 'mode-motion-move 'pending-delete t)
  1232. (put 'mode-motion-copy 'pending-delete t)
  1233.  
  1234. (defun mode-motion-move ()
  1235.   "Move the motion active region to point." 
  1236.   (interactive)
  1237.   (mode-motion-insert-text (mode-motion-copy/delete t)))
  1238.  
  1239. (defun mode-motion-kill ()
  1240.   "Kill the motion active region and push it onto the kill ring."
  1241.   (interactive)
  1242.   (mode-motion-copy/delete t t t))
  1243.  
  1244. (defun mode-motion-copy ()
  1245.   "Copy the motion active region to point."
  1246.   (interactive)
  1247.   (mode-motion-insert-text (mode-motion-copy/delete)))
  1248.  
  1249. (defun mode-motion-copy-as-kill ()
  1250.   "Delete the motion active region and push it onto the kill ring.
  1251. Set point to the place where deletion happened."
  1252.   (interactive)
  1253.   (mode-motion-copy/delete nil t)
  1254.   (message "Text copied to the to ring and cut buffer."))
  1255.  
  1256. (defun mode-motion-copy/delete (&optional delete copy-as-kill set-point)
  1257.   "Return the string that is designated by the current motion active region. 
  1258. Arguments are:
  1259.            EVENT - a mouse click event used to identify the buffer and window 
  1260. &optional DELETE - delete the motion active text region
  1261.     COPY-AS-KILL - copy the string to the kill ring
  1262.        SET-POINT - set point to the start of the motion active region."
  1263.   (let ((old-buf (current-buffer))
  1264.     (old-window (selected-window)))
  1265.     (unwind-protect 
  1266.     (let ((extent (or primary-selection-extent
  1267.               (and (extentp mode-motion-last-extent)
  1268.                    (not (extent-property mode-motion-last-extent
  1269.                              'detached))
  1270.                    mode-motion-last-extent))))
  1271.  
  1272.       (if (and (extentp extent)
  1273.            (set-buffer (extent-buffer extent))
  1274.            (not 
  1275.             ;; zero length extents
  1276.             (= (extent-start-position extent)
  1277.                (extent-end-position extent))))
  1278.  
  1279.           (let* ((start (extent-start-position extent))
  1280.              (end (extent-end-position extent))
  1281.              (text 
  1282.               (buffer-substring
  1283.                (extent-start-position extent)
  1284.                (extent-end-position extent))))
  1285.  
  1286.         (cond (copy-as-kill
  1287.                (copy-region-as-kill start end)
  1288.                (if (or (not kill-hooks)
  1289.                 (eq kill-hooks 'ignore))
  1290.                (progn 
  1291.                  (x-own-selection-internal 'PRIMARY text)
  1292.                  (x-own-clipboard text)))))
  1293.  
  1294.         (cond (delete 
  1295.                (kill-region start end)
  1296.                (x-own-selection-internal 'PRIMARY text)
  1297.                ;; (select-window window)
  1298.                (if set-point 
  1299.                (goto-char start))))
  1300.  
  1301.         (setq this-command 'mode-motion+)
  1302.         text)
  1303.         (error "No current primary or motion selection.")
  1304.         ))
  1305.       (set-buffer old-buf)
  1306.       (select-window old-window))))
  1307.  
  1308. (defun mode-motion-insert-text (text)
  1309.   "Insert TEXT at point. Also insert one space if the 
  1310. preceeding character is a word constituent or a closing paren."
  1311.   (or text (error "No highlighted text to copy."))
  1312.   (let ((prec-char-syntax (char-syntax (preceding-char))))
  1313.     (if (memq  prec-char-syntax '(?w ?\))) (insert " "))
  1314.     (insert text)))
  1315.  
  1316. ;; Boundary functions
  1317. ;;
  1318. ;; The following  functions are already provided by the thing package:
  1319. ;; thing-boundaries
  1320. ;; thing-symbol
  1321. ;; thing-word
  1322.  
  1323. (defun char-boundaries (point) (thing-region point (1+ point)))
  1324.       
  1325. (defun visible-line-boundaries (point)
  1326.   (save-excursion
  1327.     (goto-char point)
  1328.     (beginning-of-line)
  1329.     (skip-chars-forward " \t")
  1330.     (if (and (eq major-mode 'dired-mode)
  1331.          (save-excursion (dired-move-to-filename)))
  1332.     (let ((start (point)))
  1333.       (end-of-line)
  1334.       (skip-chars-backward " \t")
  1335.       (thing-region start (point))))))
  1336.  
  1337. (defun line-boundaries (point)
  1338.   (save-excursion
  1339.     (goto-char point)
  1340.     (beginning-of-line)
  1341.     (if (and (eq major-mode 'dired-mode)
  1342.          (save-excursion (dired-move-to-filename)))
  1343.     (let ((start (point)))
  1344.       (end-of-line)
  1345.       (thing-region start (point))))))
  1346.  
  1347. (defun cvs-line-boundaries (point)
  1348.     (save-excursion
  1349.       (goto-char point)
  1350.       (beginning-of-line)
  1351.       (if (looking-at "^[* ] ")
  1352.       (thing-region  (point) (progn (end-of-line) (point))))))
  1353.       
  1354. (defun latex-boundaries (here)
  1355.   (setq *last-thing* 'sexp)
  1356.   (tex-boundaries 
  1357.    here ?\\ "a-zA-Z"
  1358.    ;; begin-fwd-regexp
  1359.    "\\\\begin *{ *\\([a-z]*\\) *}"
  1360.    ;; end-fwd-regexp
  1361.    "\\(\\\\end *{ *%s *}\\)\\|\\(\\\\begin *{ *%s *}\\)"
  1362.    ;; begin-bwd-regexp
  1363.    "\\\\end *{ *\\([a-z]*\\) *}"
  1364.    ;; begin-bwd-regexp
  1365.    "\\(\\\\end *{ *%s *}\\)\\|\\(\\\\begin *{ *%s *}\\)"
  1366.    ;; param-cmd-regexp
  1367.    "\\\\[a-zA-Z]+[ \n\t]*{"))
  1368.  
  1369. (defvar texinfo-paired-commands 
  1370.   (mapconcat 
  1371.    'identity 
  1372.    '(
  1373.      "enumerate"
  1374.      "example"
  1375.      "group"
  1376.      "ifinfo" 
  1377.      "iftex" 
  1378.      "ignore" 
  1379.      "itemize"
  1380.      "menu"
  1381.      "quotation"
  1382.      "table"
  1383.      "tex"
  1384.      "titlepage"
  1385.      ) 
  1386.    "\\|"))
  1387.  
  1388. (defvar texinfo-begin-fwd-regexp 
  1389.   (format "@\\(%s\\)" texinfo-paired-commands))
  1390. (defvar texinfo-end-bwd-regexp
  1391.   (format "@end *\\(%s\\)" texinfo-paired-commands))
  1392.  
  1393. (defun texinfo-boundaries (here)
  1394.   (tex-boundaries 
  1395.    here ?@ "a-z"
  1396.    texinfo-begin-fwd-regexp
  1397.    ;; end-fwd-regexp
  1398.    "\\(@end *%s\\)\\|\\(@%s\\)"
  1399.    ;; end-bwd-regexp
  1400.    texinfo-end-bwd-regexp
  1401.    ;; begin-bwd-regexp
  1402.    "\\(@end *%s\\)\\|\\(@%s\\)"
  1403.    ;; param-cmd-regexp
  1404.    "@\\(TeX\\|[a-zA]+\\)[ \n\t]*{"))
  1405.  
  1406. (defun tex-boundaries 
  1407.   (here cmd-start-character cmd-word-character
  1408.     begin-fwd-regexp end-fwd-regexp
  1409.     end-bwd-regexp begin-bwd-regexp
  1410.     param-cmd-regexp)
  1411.   "Generic TeX dialect scanner.
  1412. Parameters: 
  1413. cmd-start-character: character that starts a command 
  1414.     (`\' in (La)TeX, `@' in Texinfo)
  1415. cmd-word-character:  regexpression to be used by the function
  1416.     `skip-chars-backward' allowing to skip over command 
  1417.     characters other than `cmd-start-character'
  1418. begin-fwd-regexp: regexpression matching the begin part of a 
  1419.     text stretch, used in forward search. 
  1420. end-fwd-regexp: regexpression matching the end part of a 
  1421.     text stretch, used in forward search
  1422. end-bwd-regexp: regexpression matching the end part of a 
  1423.     text stretch, used in backward search.
  1424. begin-bwd-regexp: regexpression matching the begin part of a 
  1425.     text stretch, used in backward search.
  1426. param-cmd-regexp: regexpression matching a parameterized command 
  1427.         \(including the open parenthesis\)"
  1428.   (save-excursion
  1429.     (goto-char here)
  1430.     (cond ((= (following-char) cmd-start-character)
  1431.        (forward-char 1))
  1432.       ((= (char-syntax (following-char)) ?w)
  1433.        (skip-chars-backward cmd-word-character)))
  1434.     (if (/= (preceding-char) cmd-start-character)
  1435.     (thing-boundaries here)
  1436.       (forward-char -1)
  1437.       (catch 'return 
  1438.     (cond ((looking-at begin-fwd-regexp)
  1439.            (let* ((start (point))
  1440.               (env (buffer-substring 
  1441.                 (match-beginning 1) (match-end 1)))
  1442.               (regexp (format end-fwd-regexp env env))
  1443.               (count 0))
  1444.          (while (re-search-forward regexp nil t)
  1445.            (cond ((match-beginning 2) ; \begin
  1446.               (setq count (1+ count)))
  1447.              ((match-beginning 1) ; \end
  1448.               (setq count (1- count))
  1449.               (if (= count 0) 
  1450.                   (throw 'return 
  1451.                      (thing-region start (point)))))))))
  1452.           ((looking-at end-bwd-regexp)
  1453.            (let* ((end (match-end 0))
  1454.               (env (buffer-substring 
  1455.                 (match-beginning 1) (match-end 1)))
  1456.               (regexp 
  1457.                (format begin-bwd-regexp env env))
  1458.               (count 1))
  1459.          (while (re-search-backward regexp nil t)
  1460.            (cond ((match-beginning 1) ; \end
  1461.               (setq count (1+ count)))
  1462.              ((match-beginning 2) ; \begin
  1463.               (setq count (1- count))
  1464.               (if (= count 0) 
  1465.                   (throw 'return (thing-region (point) end))))
  1466.              ))))
  1467.           ;; tex macros of the form \cmd {...}
  1468.           ((looking-at param-cmd-regexp)
  1469.            (thing-region 
  1470.         (point)
  1471.         (progn 
  1472.           (goto-char (1- (match-end 0)))
  1473.           (forward-sexp 1)
  1474.           (point))))
  1475.           ;; fetch the current macro (with backslash)
  1476.           (t (thing-region (point) (progn (forward-word 1) (point)))))))))
  1477.  
  1478. ;; special parse of buffer for valid selectable info
  1479. (defun minibuffer-selection-boundaries (point)
  1480.   (let ((old-syntax (syntax-table)))
  1481.     (unwind-protect
  1482.     (progn 
  1483.       ;; best syntax table for recognizing symbols
  1484.       (set-syntax-table emacs-lisp-mode-syntax-table)
  1485.       (let ((file-completion (eq minibuffer-completion-table
  1486.                      'read-file-name-internal))
  1487.         region
  1488.         minibuf-string        ;contents of minibuffer
  1489.         buffer-string        ;string to be highlighted (or not)
  1490.         prefix            ;prefix calculated from minibuf-string
  1491.         string            ;string to be verified in the
  1492.                     ;completion table 
  1493.         )
  1494.         (and
  1495.  
  1496.          (setq region (if file-completion
  1497.                   (thing-filename point)
  1498.                 (thing-symbol point)))
  1499.  
  1500.          (setq
  1501.           minibuf-string        ; contents of minibuffer
  1502.           (save-excursion
  1503.         (set-buffer mouse-grabbed-buffer)
  1504.         (buffer-string))
  1505.  
  1506.           buffer-string        ; string to be highlighted (or not)
  1507.           (buffer-substring (car region) (cdr region))
  1508.                
  1509.           prefix
  1510.           (if file-completion
  1511.           (file-name-nondirectory minibuf-string)
  1512.         minibuf-string)
  1513.  
  1514.           string
  1515.           (if file-completion
  1516.           (concat (file-name-directory minibuf-string) buffer-string)
  1517.         buffer-string))
  1518.          
  1519.          (if (or (and (fboundp 'ange-ftp-ftp-path)
  1520.               (or (ange-ftp-ftp-path buffer-string)
  1521.                   (ange-ftp-ftp-path string)))
  1522.              (and (fboundp 'efs-ftp-path)
  1523.               (or (efs-ftp-path buffer-string)
  1524.                   (efs-ftp-path string))))
  1525.          ;; #### Like our counterpart in mode-motion: evil evil evil
  1526.          t
  1527.            (if file-completion
  1528.            (try-completion string
  1529.                    minibuffer-completion-table
  1530.                    minibuffer-completion-predicate)
  1531.          (eq 't (try-completion string
  1532.                     minibuffer-completion-table
  1533.                     minibuffer-completion-predicate))))
  1534.  
  1535.          ;; the result is the region to be highlighted
  1536.          region)))
  1537.       (set-syntax-table old-syntax))))
  1538.  
  1539. ;; C source code scanner 
  1540. (defvar c-statement-starting-keyword-regexpr
  1541.   "\\(if\\|for\\|while\\|do\\|switch\\|break\\|continue\\)\\b")
  1542.  
  1543. (defun c-boundaries (here)
  1544.   (setq *last-thing* 'sexp)
  1545.   (save-excursion
  1546.     (goto-char here)
  1547.     (let ((following-char (following-char))
  1548.       (preceding-char (preceding-char))
  1549.       aux)
  1550.       (if (= (char-syntax following-char) ?w)
  1551.       (progn 
  1552.         (skip-chars-backward "a-zA-Z")
  1553.         (setq aux (point))
  1554.         (skip-chars-backward "\n\t ")
  1555.         (if (= (preceding-char) ?#)
  1556.         (forward-char -1)
  1557.           (goto-char aux))))
  1558.       (if (and (= following-char ?*)
  1559.            (= preceding-char ?/))
  1560.       (forward-char -1))
  1561.       (if (and (= following-char ?/)
  1562.            (= preceding-char ?*))
  1563.       (forward-char -1))
  1564.       (cond
  1565.        ((= (following-char) ?#) (c-scan-preproc-macros))
  1566.        ((looking-at "/\\*")    ; begin comment
  1567.     (let ((start (match-beginning 0)))
  1568.       (if (search-forward "*/" nil t)
  1569.           (thing-region start (match-end 0)))))
  1570.        ((looking-at "\\*/")    ; end comment
  1571.     (let ((end (match-end 0)))
  1572.       (if (search-backward "/*" nil t)
  1573.           (thing-region (match-beginning 0) end))))
  1574.        ((looking-at c-statement-starting-keyword-regexpr) ; if for while do etc
  1575.     (thing-region (match-beginning 0)
  1576.               (c-forward-statement 
  1577.                (buffer-substring (match-beginning 1) (match-end 1)))))
  1578.        ((looking-at "else\\b")
  1579.     (thing-region (match-beginning 0) (c-forward-else)))
  1580.        (t (if (= (char-syntax (following-char)) ?.)
  1581.           (thing-region here  (1+ here))
  1582.         (thing-boundaries here)))))))
  1583.  
  1584.  
  1585. (defun c-scan-preproc-macros ()
  1586.   (cond 
  1587.    ((looking-at "^#[ \n\t]*include[ \n\t]*[<\"][^>\"]*[>\"]")   ; #include
  1588.     (thing-region (match-beginning 0) (match-end 0)))
  1589.    ((looking-at "^#[ \n\t]*\\(define\\|undef\\)") ; #define, #undef
  1590.     (thing-region
  1591.      (match-beginning 0) 
  1592.      (progn 
  1593.        (end-of-line)
  1594.        (while (= (preceding-char) ?\\)
  1595.      (forward-line 1)
  1596.      (end-of-line))
  1597.        (point))))
  1598.    ;; #if, #ifdef, #ifndef, #else, #elif
  1599.    ((looking-at "^#[ \n\t]*\\(if\\|ifdef\\|ifndef\\|else\\|elif\\)\\b")
  1600.     (let ((start (match-beginning 0))
  1601.       (counter 1)
  1602.       match)
  1603.       (goto-char (match-end 0))
  1604.       (while (and (>= counter 1)
  1605.           (re-search-forward 
  1606.            "^#[ \n\t]*\\(if\\|ifdef\\|ifndef\\|endif\\)\\b"
  1607.            nil t))
  1608.     (setq match 
  1609.           (buffer-substring (match-beginning 1) (match-end 1)))
  1610.     (setq counter 
  1611.           (if (string= match "endif")
  1612.           (1- counter)
  1613.         (1+ counter))))
  1614.       (if (= counter 0)
  1615.       (thing-region start (match-end 0)))))
  1616.    ((looking-at "^#[ \n\t]*endif\\b")   ; #endif
  1617.     (let ((end (match-end 0))
  1618.       (counter 1)
  1619.       match)
  1620.       (goto-char (match-beginning 0))
  1621.       (while (and (>= counter 1)
  1622.           (re-search-backward
  1623.            "^#[ \n\t]*\\(if\\|ifdef\\|ifndef\\|endif\\)\\b"
  1624.            nil t))
  1625.     (setq match 
  1626.           (buffer-substring (match-beginning 1) (match-end 1)))
  1627.     (setq counter 
  1628.           (if (string= match "endif")
  1629.           (1+ counter)
  1630.         (1- counter))))
  1631.       (if (= counter 0)
  1632.       (thing-region (match-beginning 0) end))))))
  1633.  
  1634. (defun c-skip-over-comment ()
  1635.   (let ((aux (point)))
  1636.     (skip-chars-forward "\n\t ")
  1637.     (or (and (= (following-char) ?/)
  1638.          (= (char-after (1+ (point))) ?*)
  1639.          (search-forward "*/" nil t)
  1640.          (point))
  1641.     (goto-char aux))))
  1642.  
  1643. (defun c-forward-statement (&optional keyword)
  1644.   (c-skip-over-comment)
  1645.   (skip-chars-forward " \n\t")
  1646.   (or keyword (setq keyword 
  1647.             (if (looking-at c-statement-starting-keyword-regexpr)
  1648.             (buffer-substring 
  1649.              (match-beginning 1)
  1650.              (match-end 1)))))
  1651.   (if keyword
  1652.       (cond ((string= keyword "if")
  1653.          (c-forward-if))
  1654.         ((string= keyword "do")
  1655.          (c-forward-do-while))
  1656.         ((member keyword '("for" "while" "switch"))
  1657.          (c-forward-for/while/switch))
  1658.         ((member keyword '("break" "continue"))
  1659.          (c-forward-break/continue)))
  1660.     (cond ((= (following-char) ?\{)
  1661.        (forward-list 1)
  1662.        (point))
  1663.       (t
  1664.        ;; Here I use that each C statement other then 
  1665.        ;; a bloc, if, while, for, do ... ends in a `;'
  1666.        (let (char)
  1667.          (catch 'exit
  1668.            (while t
  1669.          (if (eobp) (throw 'exit nil))
  1670.          (setq char (following-char))
  1671.          (cond ((= (char-syntax char) ?.) 
  1672.             (forward-char 1)
  1673.             (if (= char ?\;) (throw 'exit (point))))
  1674.                (t (forward-sexp 1)
  1675.               (skip-chars-forward " \n\t"))))))))))
  1676.  
  1677. (defun c-forward-if ()
  1678.   (let (aux)
  1679.     (forward-word 1) ; if
  1680.     (forward-list 1) 
  1681.     (c-forward-statement)
  1682.     (setq aux (point))
  1683.     (skip-chars-forward "\n\t ")
  1684.     (if (looking-at "else\\b")
  1685.     (c-forward-else)
  1686.     (goto-char aux))))
  1687.  
  1688. (defun c-forward-else ()
  1689.   (forward-word 1) ; else
  1690.   (c-forward-statement))
  1691.  
  1692. (defun c-forward-for/while/switch ()
  1693.   (forward-word 1) ; for
  1694.   (forward-list 1)
  1695.   (c-forward-statement))
  1696.  
  1697. (defun c-forward-do-while ()
  1698.   (forward-word 1) ; do ... while
  1699.   (c-forward-statement)
  1700.   (c-forward-for/while/switch))
  1701.  
  1702. (defun c-forward-switch ()
  1703.   (forward-word 1) ; switch
  1704.   (forward-list 2)
  1705.   (point))
  1706.  
  1707. (defun c-forward-break/continue ()
  1708.   (forward-word 1) ; keyword
  1709.   (c-skip-over-comment)
  1710.   (skip-chars-forward "\n\t ")
  1711.   (if (= (following-char) ?\;)
  1712.       (goto-char (1+ (point)))))
  1713.  
  1714. ;; Tcl syntax scanner
  1715. (defvar tcl-builtin-commands nil
  1716.   "Alist of information about tcl syntax for the tcl-boundaries function.  
  1717. An entry has the form 
  1718.     \(<command-string> . <syntax description>\) 
  1719. where 
  1720.     <command-string>     is the name of a tcl command
  1721.     <syntax description> is one of 
  1722.             list of integers: the number of possible arguments
  1723.         t:              any number of arguments")
  1724.  
  1725. (defconst tcl-commands
  1726.   '(
  1727.     ("append"    . (2 . nil))
  1728.     ("array"    . (2 . 3))
  1729.     ("break"    . 0)
  1730.     ("case"     . 3)
  1731.     ("catch"    . 1)
  1732.     ("cd"    . 1)
  1733.     ("close"    . 1)
  1734.     ("concat"    . t)
  1735.     ("continue"    . 0)
  1736.     ("else"     . (1 . nil))
  1737.     ("elseif"    . (1 . nil))
  1738.     ("eof"    . 1)
  1739.     ("error"    . t)
  1740.     ("eval"     . t)
  1741.     ("exec"     . t)
  1742.     ("exit"    . (0 . 1))
  1743.     ("expr"     . 1)
  1744.     ("file"    . (2 . nil))
  1745.     ("flush"    . 1)
  1746.     ("for"     . 4)
  1747.     ("foreach"     . 3)
  1748.     ("format"    . (1 . nil))
  1749.     ("gets"    . (1 . 2))
  1750.     ("glob"    . t)
  1751.     ("global"     . (1 . nil))
  1752.     ("history"    . t)
  1753.     ("if"     . (2 . nil))
  1754.     ("incr"     . (1 . 2))
  1755.     ("info"    . (1 . 4))
  1756.     ("join"    . (1 . 2))
  1757.     ("lappend"    . (2 . nil))
  1758.     ("lindex"     . 2)
  1759.     ("linsert"    . (3 . nil))
  1760.     ("list"    . t)
  1761.     ("llength"     . 1)
  1762.     ("lrange"     . 3)
  1763.     ("lreplace"    . (3 . nil))
  1764.     ("lsearch"     . 2)
  1765.     ("lsort"    . 1)
  1766.     ("open"    . (1 . 2))
  1767.     ("proc"     . 3)
  1768.     ("puts"    . (1 . 3))
  1769.     ("pwd"    . 0)
  1770.     ("read"    . (1 . 2))
  1771.     ("regexp"    . (2 . nil))
  1772.     ("regsub"    . (4 . 6))
  1773.     ("rename"    . 2)
  1774.     ("return"    . (0 .1))
  1775.     ("scan"    . (3 . nil))
  1776.     ("seek"    . (2 . 3))
  1777.     ("set"     . (1 . 2))
  1778.     ("source"    . 1)
  1779.     ("split"    . (1 . 2))
  1780.     ("string"    . (2 . 4))
  1781.     ("tell"    . 1)
  1782.     ("time"    . (1 .2))
  1783.     ("trace"    . (1 . nil))
  1784.     ("unknown"    . (1 . nil))
  1785.     ("unset"    . (1 . nil))
  1786.     ("uplevel"    . (1 . nil))
  1787.     ("upvar"    . (2 . nil))
  1788.     ("while"     . 2)
  1789.     ))
  1790.  
  1791. (defconst tk-commands
  1792.   '(("bind"    . 3)
  1793.     ("button"    . t)
  1794.     ("canvas"    . t)
  1795.     ("frame"    . t)
  1796.     ("label"    . t)
  1797.     ("listbox"    . t)
  1798.     ("menu"    . t)
  1799.     ("menubutton"    . t)
  1800.     ("pack"    . t)
  1801.     ("scrollbar"    . t)
  1802.     ("tree"    . t)
  1803.     ("wm"        . t)
  1804.     ))
  1805.  
  1806. (defconst tcl-tk-commands
  1807.   (nconc tcl-commands tk-commands))
  1808.   
  1809. (defconst tcl-tk-commands-regexp
  1810.   (format "\\(%s\\\)\\W" (mapconcat 'car tcl-tk-commands "\\|")))
  1811.  
  1812. (defun tcl-boundaries (here)
  1813.   (save-excursion
  1814.     (goto-char here)
  1815.     (skip-chars-backward "a-z")
  1816.     (if (looking-at 
  1817.      tcl-tk-commands-regexp)
  1818.     (let* ((count 0) 
  1819.           (start (point))
  1820.           (keyword (buffer-substring
  1821.             (match-beginning 1)
  1822.             (match-end 1)))
  1823.           (syntax-description 
  1824.            (cdr (assoc keyword tcl-tk-commands))))
  1825.       (goto-char (match-end 0))
  1826.       (while (not (looking-at "[ \t]*[]\n;}]"))
  1827.         (setq count (1+ count))
  1828.         (tcl-forward-sexp1)
  1829.         ;; skipping over the parentheses of array expressions:
  1830.         (while (not (or (looking-at "[ \t]*[]\n;}]")
  1831.                 (= (char-syntax (following-char)) ? )))
  1832.           (tcl-forward-sexp1)))
  1833.  
  1834.       (if (cond ((eq syntax-description t))
  1835.             ((integerp syntax-description) 
  1836.              (= syntax-description count))
  1837.             ((consp syntax-description)
  1838.              (and (<= (car syntax-description) count)
  1839.               (or (null (cdr syntax-description))
  1840.                   (<= count (cdr syntax-description))))))
  1841.           (progn 
  1842.         (message "`%s' matched."  keyword)
  1843.         (thing-region start (point)))
  1844.         (progn 
  1845.           (message "wrong syntax: `%s'."  keyword)
  1846.           nil)))
  1847.       (message "")
  1848.       (thing-boundaries here))))
  1849.  
  1850. (defun tcl-forward-sexp (&optional arg)
  1851.   "Move forward across one balanced tcl expression.
  1852. With argument, do it that many times."
  1853.   (interactive "p")
  1854.   (if (< arg 0) (error "negative argument not allowed"))
  1855.   (or arg (setq arg 1))
  1856.   (while (> arg 0)
  1857.     (tcl-forward-sexp1)
  1858.     (setq arg (1- arg))))
  1859.  
  1860. (defun tcl-forward-sexp1 ()
  1861.   (interactive "")  
  1862.   (let ((start (point))
  1863.     next-char syntax (first-scan t))
  1864.     (setq next-char (following-char)
  1865.       syntax (char-syntax next-char))
  1866.  
  1867.     (while (or (= next-char ?\;)
  1868.            (memq syntax '(? ?>)))
  1869.       (forward-char 1)
  1870.       (setq next-char (following-char)
  1871.         syntax (char-syntax next-char)))
  1872.  
  1873.     (condition-case var
  1874.     (catch 'exit 
  1875.       (while t
  1876.         (setq next-char (following-char)
  1877.           syntax (char-syntax next-char))
  1878.         (cond ((= next-char ?\;)
  1879.            (throw 'exit nil))
  1880.           ((memq syntax (if first-scan '(? ?>) '(? ?> ?\))))
  1881.            (throw 'exit nil))
  1882.           (t 
  1883.            (goto-char (or (scan-sexps (point) 1) 
  1884.                   (point-max)))))
  1885.         (setq first-scan nil)))
  1886.       (error (goto-char start)
  1887.          (error (car (cdr var)))))))
  1888.  
  1889. ;; (define-key tcl-mode-map "\M-\C-f" 'tcl-forward-sexp)
  1890.  
  1891. (defun mode-motion-eval-func (eval-func)
  1892.   (let ((old-buf (current-buffer))
  1893.     (old-window (selected-window)))
  1894.     (unwind-protect 
  1895.     (let ((extent (or primary-selection-extent
  1896.               (and (extentp mode-motion-last-extent)
  1897.                    (not (extent-property mode-motion-last-extent
  1898.                              'detached))
  1899.                    mode-motion-last-extent))))
  1900.  
  1901.       (if (and (extentp extent)
  1902.            (set-buffer (extent-buffer extent))
  1903.            (not 
  1904.             ;; zero length extents
  1905.             (= (extent-start-position extent)
  1906.                (extent-end-position extent))))
  1907.  
  1908.           (let* ((start (extent-start-position extent))
  1909.              (end (extent-end-position extent)))
  1910.  
  1911.         (funcall eval-func start end))
  1912.  
  1913.         (error "No current primary or motion selection.")
  1914.         ))
  1915.       (set-buffer old-buf)
  1916.       (select-window old-window))))
  1917.  
  1918. (defun mode-motion-eval-region ()
  1919.   (interactive)
  1920.   (mode-motion-eval-func 'eval-region))
  1921.  
  1922.  
  1923. ;; Motion highlight faces and initialization.
  1924.  
  1925. (defun sect-handler (string)
  1926.   "Return the symbol corresponding to the foo-STRING handler for this sect."
  1927.   (intern-soft (concat (symbol-name mode-motion+-religion) string)))
  1928.  
  1929. (defun mode-motion-init-handlers-according-to-religion (&optional forcep)
  1930.   (interactive)
  1931.   ;; Initialise default motion handlers depending on religious sect!
  1932.   (let ((foo-thing (sect-handler "-thing"))
  1933.     (foo-c (sect-handler "-c"))
  1934.     (foo-LaTeX (sect-handler "-laTeX"))
  1935.     (foo-line@ (sect-handler "-line@"))
  1936.     (foo-vline@ (sect-handler "-vline@")))
  1937.     (if forcep
  1938.     (progn
  1939.       (setq default-motion-handler (find-motion-handler foo-thing))
  1940.       (set-mode-motion-handler 'emacs-lisp-mode foo-thing)
  1941.       (set-mode-motion-handler 'lisp-interaction-mode foo-thing)
  1942.       (set-mode-motion-handler 'c-mode foo-c)
  1943.       (set-mode-motion-handler 'c++-mode foo-c)
  1944.       (set-mode-motion-handler 'c++-c-mode foo-c)
  1945.       (set-mode-motion-handler 'tex-mode foo-LaTeX)
  1946.       (set-mode-motion-handler 'latex-mode foo-LaTeX)
  1947.       (set-mode-motion-handler 'Buffer-menu-mode foo-vline@)
  1948.       (set-mode-motion-handler 'Electric-Buffer-menu-mode foo-vline@)
  1949.       (set-mode-motion-handler 'gnus-Group-mode foo-vline@)
  1950.       (set-mode-motion-handler 'gnus-Subject-mode foo-vline@)
  1951.       (set-mode-motion-handler 'gnus-group-mode foo-vline@)
  1952.       (set-mode-motion-handler 'gnus-subject-mode foo-vline@)
  1953.       (set-mode-motion-handler 'gnus-summary-mode foo-vline@)
  1954.       (set-mode-motion-handler 'dired-mode foo-line@)
  1955.       (set-mode-motion-handler 'compilation-mode foo-line@)
  1956.       (set-mode-motion-handler 'occur-mode foo-line@)
  1957.       (set-mode-motion-handler 'tar-mode foo-vline@)
  1958.       (set-mode-motion-handler 'rmail-summary-mode foo-vline@)
  1959.       (set-mode-motion-handler 'vm-summary-mode (sect-handler "-line"))
  1960.       (set-mode-motion-handler 'tcl-mode (sect-handler "-tcl"))
  1961.       (set-mode-motion-handler 'texinfo-mode (sect-handler "-TeXinfo"))
  1962.       (set-mode-motion-handler 'cvs-mode (sect-handler "-cvs-line")))
  1963.       (setq default-motion-handler
  1964.         (or default-motion-handler (find-motion-handler foo-thing)))
  1965.       (or (get 'emacs-lisp-mode 'mode-motion-handler)
  1966.       (set-mode-motion-handler 'emacs-lisp-mode foo-thing))
  1967.       (or (get 'lisp-interaction-mode 'mode-motion-handler)
  1968.       (set-mode-motion-handler 'lisp-interaction-mode foo-thing))
  1969.       (or (get 'c-mode 'mode-motion-handler)
  1970.       (set-mode-motion-handler 'c-mode foo-c))
  1971.       (or (get 'c++-mode 'mode-motion-handler)
  1972.       (set-mode-motion-handler 'c++-mode foo-c))
  1973.       (or (get 'c++-c-mode 'mode-motion-handler)
  1974.       (set-mode-motion-handler 'c++-c-mode foo-c))
  1975.       (or (get 'tex-mode 'mode-motion-handler)
  1976.       (set-mode-motion-handler 'tex-mode foo-LaTeX))
  1977.       (or (get 'latex-mode 'mode-motion-handler)
  1978.       (set-mode-motion-handler 'latex-mode foo-LaTeX))
  1979.       (or (get 'Buffer-menu-mode 'mode-motion-handler)
  1980.       (set-mode-motion-handler 'Buffer-menu-mode foo-vline@))
  1981.       (or (get 'Electric-Buffer-menu-mode 'mode-motion-handler)
  1982.       (set-mode-motion-handler 'Electric-Buffer-menu-mode foo-vline@))
  1983.       (or (get 'gnus-Group-mode 'mode-motion-handler)
  1984.       (set-mode-motion-handler 'gnus-Group-mode foo-vline@))
  1985.       (or (get 'gnus-Subject-mode 'mode-motion-handler)
  1986.       (set-mode-motion-handler 'gnus-Subject-mode foo-vline@))
  1987.       (or (get 'gnus-group-mode 'mode-motion-handler)
  1988.       (set-mode-motion-handler 'gnus-group-mode foo-vline@))
  1989.       (or (get 'gnus-subject-mode 'mode-motion-handler)
  1990.       (set-mode-motion-handler 'gnus-subject-mode foo-vline@))
  1991.       (or (get 'gnus-summary-mode 'mode-motion-handler)
  1992.       (set-mode-motion-handler 'gnus-summary-mode foo-vline@))
  1993.       (or (get 'dired-mode 'mode-motion-handler)
  1994.       (set-mode-motion-handler 'dired-mode foo-line@))
  1995.       (or (get 'compilation-mode 'mode-motion-handler)
  1996.       (set-mode-motion-handler 'compilation-mode foo-line@))
  1997.       (or (get 'occur-mode 'mode-motion-handler)
  1998.       (set-mode-motion-handler 'occur-mode foo-line@))
  1999.       (or (get 'tar-mode 'mode-motion-handler)
  2000.       (set-mode-motion-handler 'tar-mode foo-vline@))
  2001.       (or (get 'rmail-summary-mode 'mode-motion-handler)
  2002.       (set-mode-motion-handler 'rmail-summary-mode foo-vline@))
  2003.       (or (get 'vm-summary-mode 'mode-motion-handler)
  2004.       (set-mode-motion-handler 'vm-summary-mode (sect-handler "-line")))
  2005.       (or (get 'tcl-mode 'mode-motion-handler)
  2006.       (set-mode-motion-handler 'tcl-mode (sect-handler "-tcl")))
  2007.       (or (get 'texinfo-mode 'mode-motion-handler)
  2008.       (set-mode-motion-handler 'texinfo-mode (sect-handler "-TeXinfo")))
  2009.       (or (get 'cvs-mode 'mode-motion-handler)
  2010.       (set-mode-motion-handler 'cvs-mode (sect-handler "-cvs-line"))))))
  2011.  
  2012. ;; Null Handlers (for disabling motion highlighting)
  2013. (defun thing-null (here) nil)
  2014. (make-motion-handler 'no-thing 'thing-null)
  2015. (make-motion-handler 'no-c 'thing-null)
  2016. (make-motion-handler 'no-laTeX 'thing-null)
  2017. (make-motion-handler 'no-line 'thing-null)
  2018. (make-motion-handler 'no-line@ 'thing-null)
  2019. (make-motion-handler 'no-vline 'thing-null)
  2020. (make-motion-handler 'no-vline@ 'thing-null)
  2021. (make-motion-handler 'no-tcl 'thing-null)
  2022. (make-motion-handler 'no-TeXinfo 'thing-null)
  2023. (make-motion-handler 'no-cvs-line 'thing-null)
  2024.  
  2025. (defun mode-motion-init ()
  2026.   "enable mode-motion+ package"
  2027.   (interactive)
  2028.  
  2029. (setq mode-motion-last-extent nil)
  2030.   
  2031. (global-set-key '(meta button2) 'mode-motion-copy)
  2032. (global-set-key '(meta shift button2) 'mode-motion-move)
  2033. (global-set-key '(meta control button2) 'mode-motion-kill)
  2034. (global-set-key '(meta control shift button2) 'mode-motion-copy-as-kill)
  2035. (global-set-key '(meta control symbol button2) 'mode-motion-copy-as-kill)
  2036.  
  2037. (if mode-motion-setup-cut-and-paste-bindings
  2038.     (progn 
  2039.       (global-set-key 'f16 'mode-motion-copy-as-kill) ; Copy
  2040.       (global-set-key 'f18 'yank)                  ; Paste
  2041.       (global-set-key 'f20 'mode-motion-kill)))       ; Cut
  2042.  
  2043. ;; I don't want the thing-boundaries function select whitespaces 
  2044. (setq thing-report-whitespace nil thing-report-char-p nil)
  2045.  
  2046. ;; bold motion face (bold, if this is not the default, unbold otherwise)
  2047. (if (find-face 'motion-bold)
  2048.     ()
  2049.   (make-face 'motion-bold)
  2050.   (make-face-bold 'motion-bold)
  2051.   (or (face-differs-from-default-p 'motion-bold)
  2052.       (make-face-unbold 'motion-bold)))
  2053.  
  2054. ;; an underline face
  2055. (if (find-face 'motion-underline)
  2056.     ()
  2057.   (make-face 'motion-underline)
  2058.   (set-face-underline-p 'motion-underline t))
  2059.  
  2060. ;; an inverted face
  2061. (if (find-face 'motion-inverted)
  2062.     ()
  2063.   (make-face 'motion-inverted)
  2064.   (make-face-bold 'motion-inverted)
  2065.   (invert-face 'motion-inverted))
  2066.  
  2067. (if (find-face 'motion-gray)
  2068.     ()
  2069.   (make-face 'motion-gray)
  2070.   (set-face-background-pixmap 'motion-gray "gray1.xbm"))
  2071.  
  2072. ;; Motion Handlers
  2073.  
  2074. ;; Special Minibuffer handler
  2075.  
  2076. (make-motion-handler 'minibuffer 'minibuffer-selection-boundaries 'highlight t nil)
  2077.  
  2078. ;; Things
  2079. (make-motion-handler 'bold-thing 'thing-boundaries 'motion-bold)
  2080. (make-motion-handler 'gray-thing 'thing-boundaries 'motion-gray)
  2081. (make-motion-handler 'highlight-thing 'thing-boundaries 'highlight)
  2082. (make-motion-handler 'invert-thing 'thing-boundaries 'motion-inverted)
  2083. (make-motion-handler 'underline-thing 'thing-boundaries 'motion-underline)
  2084.  
  2085. ;; Lines
  2086. (make-motion-handler 'bold-line 'line-boundaries 'motion-bold)
  2087. (make-motion-handler 'gray-line 'line-boundaries 'motion-gray)
  2088. (make-motion-handler 'highlight-line 'line-boundaries 'highlight)
  2089. (make-motion-handler 'invert-line 'line-boundaries 'motion-inverted)
  2090. (make-motion-handler 'underline-line 'line-boundaries 'motion-underline)
  2091. (make-motion-handler 'bold-line@ 'line-boundaries 'motion-bold t t)
  2092. (make-motion-handler 'gray-line@ 'line-boundaries 'motion-gray nil t)
  2093. (make-motion-handler 'highlight-line@ 'line-boundaries 'highlight nil t)
  2094. (make-motion-handler 'invert-line@ 'line-boundaries 'motion-inverted nil t)
  2095. (make-motion-handler 'underline-line@ 'line-boundaries 'motion-underline nil t)
  2096.  
  2097. ;; Visible text of line
  2098. (make-motion-handler 'bold-vline 'visible-line-boundaries 'motion-bold)
  2099. (make-motion-handler 'gray-vline 'visible-line-boundaries 'motion-gray)
  2100. (make-motion-handler 'highlight-vline 'visible-line-boundaries 'highlight)
  2101. (make-motion-handler 'invert-vline 'visible-line-boundaries 'motion-inverted)
  2102. (make-motion-handler 'underline-vline 'visible-line-boundaries 'motion-underline)
  2103. (make-motion-handler 'bold-vline@ 'visible-line-boundaries 'motion-bold t t)
  2104. (make-motion-handler 'gray-vline@ 'visible-line-boundaries 'motion-gray nil t)
  2105. (make-motion-handler 'highlight-vline@ 'visible-line-boundaries 'highlight nil t)
  2106. (make-motion-handler 'invert-vline@ 'visible-line-boundaries 'motion-inverted nil t)
  2107. (make-motion-handler 'underline-vline@ 'visible-line-boundaries 'motion-underline nil t)
  2108.  
  2109. ;; CVS lines
  2110. (make-motion-handler 'bold-cvs-line 'cvs-line-boundaries 'motion-bold)
  2111. (make-motion-handler 'gray-cvs-line 'cvs-line-boundaries 'motion-gray)
  2112. (make-motion-handler 'highlight-cvs-line 'cvs-line-boundaries 'highlight)
  2113. (make-motion-handler 'invert-cvs-line 'cvs-line-boundaries 'motion-inverted)
  2114. (make-motion-handler
  2115.  'underline-cvs-line 'cvs-line-boundaries 'motion-underline)
  2116.  
  2117. ;; (La)TeX 
  2118. (make-motion-handler 'bold-LaTeX 'latex-boundaries 'motion-bold)
  2119. (make-motion-handler 'gray-LaTeX 'latex-boundaries 'motion-gray)
  2120. (make-motion-handler 'highlight-LaTeX 'latex-boundaries 'highlight)
  2121. (make-motion-handler 'invert-LaTeX 'latex-boundaries 'motion-inverted)
  2122. (make-motion-handler 'underline-LaTeX 'latex-boundaries 'motion-underline)
  2123.  
  2124. ;; TeXinfo
  2125. (make-motion-handler 'bold-TeXinfo 'texinfo-boundaries 'motion-bold)
  2126. (make-motion-handler 'gray-TeXinfo 'texinfo-boundaries 'motion-gray)
  2127. (make-motion-handler 'highlight-TeXinfo 'texinfo-boundaries 'highlight)
  2128. (make-motion-handler 'invert-TeXinfo 'texinfo-boundaries 'motion-inverted)
  2129. (make-motion-handler 'underline-TeXinfo 'texinfo-boundaries 'motion-underline)
  2130.  
  2131. ;; C and C++
  2132. (make-motion-handler 'bold-c 'c-boundaries 'motion-bold)
  2133. (make-motion-handler 'gray-c 'c-boundaries 'motion-gray)
  2134. (make-motion-handler 'highlight-c 'c-boundaries 'highlight)
  2135. (make-motion-handler 'invert-c 'c-boundaries 'motion-inverted)
  2136. (make-motion-handler 'underline-c 'c-boundaries 'motion-underline)
  2137.  
  2138. ;; Tcl/Tk
  2139. (make-motion-handler 'bold-tcl 'tcl-boundaries 'motion-bold)
  2140. (make-motion-handler 'gray-tcl 'tcl-boundaries 'motion-gray)
  2141. (make-motion-handler 'highlight-tcl 'tcl-boundaries 'highlight)
  2142. (make-motion-handler 'invert-tcl 'tcl-boundaries 'motion-inverted)
  2143. (make-motion-handler 'underline-tcl 'tcl-boundaries 'motion-underline)
  2144.  
  2145. ;; mouse tracker
  2146. (make-motion-handler 'track-mouse@ 'char-boundaries nil nil t)
  2147. (make-motion-handler 'highlight-char 'char-boundaries 'highlight)
  2148.  
  2149. ;; augment the basic mouse motion handler (if any)
  2150. (setq-default mode-motion-hook 
  2151.           (if (listp mode-motion-hook)
  2152.           (if (memq #'mode-motion+-highlight mode-motion-hook)
  2153.               mode-motion-hook
  2154.             (append mode-motion-hook (list #'mode-motion+-highlight)))
  2155.         (list mode-motion-hook #'mode-motion+-highlight)))
  2156.  
  2157. (or mode-motion+-religion 
  2158.     (setq mode-motion+-religion (if (x-display-color-p) 'underline 'invert)))
  2159.  
  2160. (add-menu '("Options") (car mode-motion+-options-menu)
  2161.       (cdr mode-motion+-options-menu)
  2162.       "Paren Highlighting")
  2163.  
  2164. ;; shut your eyes, this is a kludge. I didn't have time to find/write
  2165. ;; a function to do this.
  2166. (or (member ["Eval Motion Region" mode-motion-eval-region t]
  2167.         lisp-interaction-popup-menu)
  2168.     (and (setq lisp-interaction-popup-menu
  2169.            (copy-sequence lisp-interaction-popup-menu))
  2170.      (setcdr (nthcdr 1 lisp-interaction-popup-menu)
  2171.          (cons ["Eval Motion Region" mode-motion-eval-region t]
  2172.                (nthcdr 2 lisp-interaction-popup-menu)))))
  2173.  
  2174. (or (member ["Eval Motion Region" mode-motion-eval-region t]
  2175.         emacs-lisp-popup-menu)
  2176.     (and (setq emacs-lisp-popup-menu (copy-sequence emacs-lisp-popup-menu))
  2177.      (setcdr (nthcdr 3 emacs-lisp-popup-menu)
  2178.          (cons ["Eval Motion Region" mode-motion-eval-region t]
  2179.                (nthcdr 4 emacs-lisp-popup-menu)))))
  2180.  
  2181. ;; Clear the last active motion extent when leaving a frame.
  2182. (if (boundp 'mouse-leave-frame-hook)
  2183.     (add-hook 'mouse-leave-frame-hook 'mode-motion-clear-last-extent)
  2184.   (add-hook 'mouse-leave-screen-hook 'mode-motion-clear-last-extent))
  2185.            
  2186. (run-hooks 'mode-motion+-load-hook)
  2187. (mode-motion-init-handlers-according-to-religion)
  2188.  
  2189. (if (interactive-p) (message "mode-motion+ enabled")))
  2190.  
  2191. (if (and (not purify-flag)
  2192.      (or (not (boundp 'opt-mode-motion+)) opt-mode-motion+))
  2193.     (mode-motion-init))
  2194.  
  2195. (provide 'mode-motion+)
  2196. ;; end mode-motion+
  2197.